Climate_corrs_pcas
Brandie QC
2025-08-01
Code for Figures 1 and S1; Table S2 and S3
Load libraries
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(ggrepel) #for repelling labels
library(corrplot) #plotting correlations ## corrplot 0.94 loadedlibrary(vegan) #for permanova ## Loading required package: permute
## Loading required package: latticelibrary(ggfortify) #plotting PCAs
library(viridis) #for color scale## Loading required package: viridisLite#making topo maps:
library(elevatr)## elevatr v0.99.0 NOTE: Version 0.99.0 of 'elevatr' uses 'sf' and 'terra'. Use
## of the 'sp', 'raster', and underlying 'rgdal' packages by 'elevatr' is being
## deprecated; however, get_elev_raster continues to return a RasterLayer. This
## will be dropped in future versions, so please plan accordingly.library(terra)## terra 1.7.78
##
## Attaching package: 'terra'
##
## The following object is masked from 'package:tidyr':
##
## extractlibrary(sf)## Linking to GEOS 3.11.0, GDAL 3.5.3, PROJ 9.1.0; sf_use_s2() is TRUElibrary(giscoR)
library(marmap)## Registered S3 methods overwritten by 'adehabitatMA':
## method from
## print.SpatialPixelsDataFrame sp
## print.SpatialPixels sp
##
## Attaching package: 'marmap'
##
## The following object is masked from 'package:terra':
##
## as.raster
##
## The following object is masked from 'package:grDevices':
##
## as.rasterLoad Climate Data
all_clim <- read_csv("../Processed.Data/Climate/All_Clim.csv")## Rows: 2951 Columns: 23
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): parent.pop, elevation.group, timeframe, Season
## dbl (19): elev_m, Lat, Long, year, cwd, pck, ppt, tmn, tmx, ann_tmean, mean_...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.Map of populations (Figure 1a)
pops_garden_locs <- all_clim %>%
mutate_at(c("Lat", "Long"), as.double) %>%
select(parent.pop:Long) %>%
filter(!is.na(Lat), !is.na(Long)) %>%
distinct()
states <- map_data("state") %>% filter(region == "california")
ggplot() +
geom_polygon(data = states, aes(x = long, y = lat, group = group), fill = "gray") +
coord_quickmap(xlim = c(-125, -114), ylim = c(35.8, 41))+
geom_point(data = pops_garden_locs,
aes(x = Long, y = Lat, color=elev_m),
size = 3) +
geom_label_repel(data = pops_garden_locs,
aes(x = Long, y = Lat,
label = `parent.pop`),
min.segment.length = 0,
max.overlaps = 100,
#force = 3,
box.padding = 0.4,
label.padding = 0.15,
label.size = 0.1,
size = 3) +
labs(color="Elevation (m)") +
scale_colour_gradient(low = "#F5A540", high = "#0043F0") +
theme_void()
ggsave("../Figures/Pop_Map_Figure1a.png", width = 10, height = 10, units = "in")Climate variable correlations (Figure S1)
Calculate 30 year climate averages
all_clim_avgs <- all_clim %>%
select(-Lat, -Long) %>%
filter(parent.pop!="WL2_Garden") %>% #remove the garden
left_join(pops_garden_locs) %>% #add in Lat Long for growth season rows
group_by(parent.pop, elevation.group, elev_m, Lat, Long,
timeframe, Season) %>%
summarise_at(c("cwd", "pck", "ppt", "tmn", "tmx",
"ann_tmean", "mean_diurnal_range", "temp_seasonality", "temp_ann_range",
"tmean_wettest_month", "tmean_driest_month", "ann_ppt",
"ppt_seasonality","ppt_warmest_month", "ppt_coldest_month"),
c(mean), na.rm = TRUE)## Joining with `by = join_by(parent.pop, elevation.group, elev_m)`Recent Corrs - Water Year
recent_wtr_yr_avgs_normalized <- all_clim_avgs %>%
filter(timeframe=="recent", Season=="Water Year") %>%
ungroup() %>%
select(cwd:ppt_coldest_month) %>%
scale() #center and scale the data
cor.norm_recent_wtr_yr = cor(recent_wtr_yr_avgs_normalized) #test correlations among the traits
cor.sig_recent_wtr_yr <- cor.mtest(recent_wtr_yr_avgs_normalized, method = "pearson") #get pearson's test p-values
corrplot(cor.norm_recent_wtr_yr, type="upper",
tl.srt = 45, p.mat = cor.sig_recent_wtr_yr$p,
sig.level = 0.05, insig="blank")
#800 x 734Historical Corrs - Water year
historic_wtr_yr_avgs_normalized <- all_clim_avgs %>%
filter(timeframe=="historic", Season=="Water Year") %>%
ungroup() %>%
select(cwd:ppt_coldest_month) %>%
scale() #center and scale the data
cor.norm_historic_wtr_yr = cor(historic_wtr_yr_avgs_normalized) #test correlations among the traits
cor.sig_historic_wtr_yr <- cor.mtest(historic_wtr_yr_avgs_normalized, method = "pearson") #get pearson's test p-values
corrplot(cor.norm_historic_wtr_yr, type="upper",
tl.srt = 45, p.mat = cor.sig_historic_wtr_yr$p,
sig.level = 0.05, insig="blank")
#800 x 734Recent Corrs - Growth Season
recent_grwssn_avgs_normalized <- all_clim_avgs %>%
filter(timeframe=="recent", Season=="Growth Season") %>%
ungroup() %>%
select(cwd:ppt_coldest_month) %>%
scale() #center and scale the data
cor.norm_recent_grwssn = cor(recent_grwssn_avgs_normalized) #test correlations among the traits
cor.sig_recent_grwssn <- cor.mtest(recent_grwssn_avgs_normalized, method = "pearson") #get pearson's test p-values
corrplot(cor.norm_recent_grwssn, type="upper",
tl.srt = 45, p.mat = cor.sig_recent_grwssn$p,
sig.level = 0.05, insig="blank")
#800 x 734Historical Corrs - Growth Season
historic_grwssn_avgs_normalized <- all_clim_avgs %>%
filter(timeframe=="historic", Season=="Growth Season") %>%
ungroup() %>%
select(cwd:ppt_coldest_month) %>%
scale() #center and scale the data
cor.norm_historic_grwssn = cor(historic_grwssn_avgs_normalized) #test correlations among the traits
cor.sig_historic_grwssn <- cor.mtest(historic_grwssn_avgs_normalized, method = "pearson") #get pearson's test p-values
corrplot(cor.norm_historic_grwssn, type="upper",
tl.srt = 45, p.mat = cor.sig_historic_grwssn$p,
sig.level = 0.05, insig="blank")
#800 x 734Climate Change PCAs (Figure 1b-c; Table S2, S3)
Water Year PCA
wtr_yr_avgs_normalized <- all_clim_avgs %>%
filter(Season=="Water Year") %>%
ungroup() %>%
select(cwd:ppt_coldest_month) %>%
scale() #center and scale the data
cor.norm_wtr_yr = cor(wtr_yr_avgs_normalized) #test correlations among the traits
cor.sig_wtr_yr <- cor.mtest(wtr_yr_avgs_normalized, method = "pearson") #get pearson's test p-values
cor.norm_wtr_yr## cwd pck ppt tmn tmx
## cwd 1.00000000 -0.2778199 -0.6334849 0.1824027 0.2293903
## pck -0.27781989 1.0000000 0.7036374 -0.8628664 -0.8453649
## ppt -0.63348487 0.7036374 1.0000000 -0.4493381 -0.4916682
## tmn 0.18240273 -0.8628664 -0.4493381 1.0000000 0.9792912
## tmx 0.22939032 -0.8453649 -0.4916682 0.9792912 1.0000000
## ann_tmean 0.20783921 -0.8582421 -0.4737383 0.9944189 0.9951856
## mean_diurnal_range 0.28734808 -0.2099630 -0.3559296 0.2412914 0.4327692
## temp_seasonality 0.08535835 -0.4585397 -0.2927491 0.3724661 0.3709750
## temp_ann_range 0.24767575 -0.1840337 -0.3117025 0.2093605 0.3847761
## tmean_wettest_month 0.19445528 -0.8087459 -0.4334553 0.9775323 0.9901544
## tmean_driest_month 0.15228885 -0.8208410 -0.3849627 0.9861790 0.9836271
## ann_ppt -0.63348487 0.7036374 1.0000000 -0.4493381 -0.4916682
## ppt_seasonality 0.35247991 -0.7114081 -0.5116831 0.7057181 0.6429981
## ppt_warmest_month -0.21384284 0.8484319 0.4213677 -0.9273903 -0.8974292
## ppt_coldest_month -0.51790365 0.4739895 0.7853312 -0.4176279 -0.5317284
## ann_tmean mean_diurnal_range temp_seasonality
## cwd 0.2078392 0.28734808 0.08535835
## pck -0.8582421 -0.20996305 -0.45853965
## ppt -0.4737383 -0.35592963 -0.29274913
## tmn 0.9944189 0.24129144 0.37246610
## tmx 0.9951856 0.43276917 0.37097502
## ann_tmean 1.0000000 0.34233107 0.37362985
## mean_diurnal_range 0.3423311 1.00000000 0.11969846
## temp_seasonality 0.3736298 0.11969846 1.00000000
## temp_ann_range 0.3018635 0.91213380 0.44828421
## tmean_wettest_month 0.9892034 0.39340777 0.29312354
## tmean_driest_month 0.9899877 0.32361760 0.41059293
## ann_ppt -0.4737383 -0.35592963 -0.29274913
## ppt_seasonality 0.6767109 -0.06030398 0.41330610
## ppt_warmest_month -0.9166093 -0.17221356 -0.38378663
## ppt_coldest_month -0.4792638 -0.68915334 -0.07076714
## temp_ann_range tmean_wettest_month tmean_driest_month
## cwd 0.24767575 0.1944553 0.1522889
## pck -0.18403374 -0.8087459 -0.8208410
## ppt -0.31170245 -0.4334553 -0.3849627
## tmn 0.20936046 0.9775323 0.9861790
## tmx 0.38477608 0.9901544 0.9836271
## ann_tmean 0.30186346 0.9892034 0.9899877
## mean_diurnal_range 0.91213380 0.3934078 0.3236176
## temp_seasonality 0.44828421 0.2931235 0.4105929
## temp_ann_range 1.00000000 0.3296974 0.3068072
## tmean_wettest_month 0.32969743 1.0000000 0.9801624
## tmean_driest_month 0.30680720 0.9801624 1.0000000
## ann_ppt -0.31170245 -0.4334553 -0.3849627
## ppt_seasonality -0.01923439 0.5950874 0.6422224
## ppt_warmest_month -0.15552992 -0.8844125 -0.9164854
## ppt_coldest_month -0.58703197 -0.5171949 -0.4098137
## ann_ppt ppt_seasonality ppt_warmest_month
## cwd -0.6334849 0.35247991 -0.2138428
## pck 0.7036374 -0.71140813 0.8484319
## ppt 1.0000000 -0.51168311 0.4213677
## tmn -0.4493381 0.70571809 -0.9273903
## tmx -0.4916682 0.64299814 -0.8974292
## ann_tmean -0.4737383 0.67671087 -0.9166093
## mean_diurnal_range -0.3559296 -0.06030398 -0.1722136
## temp_seasonality -0.2927491 0.41330610 -0.3837866
## temp_ann_range -0.3117025 -0.01923439 -0.1555299
## tmean_wettest_month -0.4334553 0.59508741 -0.8844125
## tmean_driest_month -0.3849627 0.64222243 -0.9164854
## ann_ppt 1.0000000 -0.51168311 0.4213677
## ppt_seasonality -0.5116831 1.00000000 -0.7785066
## ppt_warmest_month 0.4213677 -0.77850659 1.0000000
## ppt_coldest_month 0.7853312 -0.15019686 0.2645227
## ppt_coldest_month
## cwd -0.51790365
## pck 0.47398947
## ppt 0.78533118
## tmn -0.41762794
## tmx -0.53172838
## ann_tmean -0.47926375
## mean_diurnal_range -0.68915334
## temp_seasonality -0.07076714
## temp_ann_range -0.58703197
## tmean_wettest_month -0.51719490
## tmean_driest_month -0.40981374
## ann_ppt 0.78533118
## ppt_seasonality -0.15019686
## ppt_warmest_month 0.26452270
## ppt_coldest_month 1.00000000cor.sig_wtr_yr$p## cwd pck ppt tmn
## cwd 0.000000e+00 6.156743e-02 2.298434e-06 2.250231e-01
## pck 6.156743e-02 0.000000e+00 4.916374e-08 1.258286e-14
## ppt 2.298434e-06 4.916374e-08 0.000000e+00 1.732637e-03
## tmn 2.250231e-01 1.258286e-14 1.732637e-03 0.000000e+00
## tmx 1.251492e-01 1.464187e-13 5.202761e-04 3.673162e-32
## ann_tmean 1.657380e-01 2.483756e-14 8.825116e-04 1.270104e-44
## mean_diurnal_range 5.282989e-02 1.613590e-01 1.519546e-02 1.062132e-01
## temp_seasonality 5.727357e-01 1.351257e-03 4.833963e-02 1.079951e-02
## temp_ann_range 9.700324e-02 2.208328e-01 3.496703e-02 1.625928e-01
## tmean_wettest_month 1.953319e-01 1.053930e-11 2.619418e-03 2.168711e-31
## tmean_driest_month 3.123245e-01 2.859308e-12 8.247654e-03 5.392913e-36
## ann_ppt 2.298434e-06 4.916374e-08 0.000000e+00 1.732637e-03
## ppt_seasonality 1.628287e-02 2.998251e-08 2.784782e-04 4.313300e-08
## ppt_warmest_month 1.535783e-01 9.740293e-14 3.541662e-03 2.090112e-20
## ppt_coldest_month 2.274928e-04 8.761763e-04 1.032132e-10 3.879606e-03
## tmx ann_tmean mean_diurnal_range
## cwd 1.251492e-01 1.657380e-01 5.282989e-02
## pck 1.464187e-13 2.483756e-14 1.613590e-01
## ppt 5.202761e-04 8.825116e-04 1.519546e-02
## tmn 3.673162e-32 1.270104e-44 1.062132e-01
## tmx 0.000000e+00 4.957242e-46 2.665434e-03
## ann_tmean 4.957242e-46 0.000000e+00 1.987202e-02
## mean_diurnal_range 2.665434e-03 1.987202e-02 0.000000e+00
## temp_seasonality 1.114505e-02 1.053625e-02 4.281583e-01
## temp_ann_range 8.281539e-03 4.146731e-02 1.183814e-18
## tmean_wettest_month 3.226246e-39 2.429382e-38 6.834275e-03
## tmean_driest_month 2.185193e-34 4.659562e-39 2.824338e-02
## ann_ppt 5.202761e-04 8.825116e-04 1.519546e-02
## ppt_seasonality 1.444691e-06 2.431457e-07 6.905504e-01
## ppt_warmest_month 3.052513e-17 3.927396e-19 2.524411e-01
## ppt_coldest_month 1.430891e-04 7.521866e-04 1.186502e-07
## temp_seasonality temp_ann_range tmean_wettest_month
## cwd 0.572735694 9.700324e-02 1.953319e-01
## pck 0.001351257 2.208328e-01 1.053930e-11
## ppt 0.048339634 3.496703e-02 2.619418e-03
## tmn 0.010799513 1.625928e-01 2.168711e-31
## tmx 0.011145053 8.281539e-03 3.226246e-39
## ann_tmean 0.010536252 4.146731e-02 2.429382e-38
## mean_diurnal_range 0.428158267 1.183814e-18 6.834275e-03
## temp_seasonality 0.000000000 1.781903e-03 4.804021e-02
## temp_ann_range 0.001781903 0.000000e+00 2.525042e-02
## tmean_wettest_month 0.048040207 2.525042e-02 0.000000e+00
## tmean_driest_month 0.004592583 3.808751e-02 1.439550e-32
## ann_ppt 0.048339634 3.496703e-02 2.619418e-03
## ppt_seasonality 0.004305085 8.990390e-01 1.289856e-05
## ppt_warmest_month 0.008463232 3.020148e-01 3.684748e-16
## ppt_coldest_month 0.640253893 1.801670e-05 2.328410e-04
## tmean_driest_month ann_ppt ppt_seasonality
## cwd 3.123245e-01 2.298434e-06 1.628287e-02
## pck 2.859308e-12 4.916374e-08 2.998251e-08
## ppt 8.247654e-03 0.000000e+00 2.784782e-04
## tmn 5.392913e-36 1.732637e-03 4.313300e-08
## tmx 2.185193e-34 5.202761e-04 1.444691e-06
## ann_tmean 4.659562e-39 8.825116e-04 2.431457e-07
## mean_diurnal_range 2.824338e-02 1.519546e-02 6.905504e-01
## temp_seasonality 4.592583e-03 4.833963e-02 4.305085e-03
## temp_ann_range 3.808751e-02 3.496703e-02 8.990390e-01
## tmean_wettest_month 1.439550e-32 2.619418e-03 1.289856e-05
## tmean_driest_month 0.000000e+00 8.247654e-03 1.501332e-06
## ann_ppt 8.247654e-03 0.000000e+00 2.784782e-04
## ppt_seasonality 1.501332e-06 2.784782e-04 0.000000e+00
## ppt_warmest_month 4.052632e-19 3.541662e-03 1.904144e-10
## ppt_coldest_month 4.678189e-03 1.032132e-10 3.190965e-01
## ppt_warmest_month ppt_coldest_month
## cwd 1.535783e-01 2.274928e-04
## pck 9.740293e-14 8.761763e-04
## ppt 3.541662e-03 1.032132e-10
## tmn 2.090112e-20 3.879606e-03
## tmx 3.052513e-17 1.430891e-04
## ann_tmean 3.927396e-19 7.521866e-04
## mean_diurnal_range 2.524411e-01 1.186502e-07
## temp_seasonality 8.463232e-03 6.402539e-01
## temp_ann_range 3.020148e-01 1.801670e-05
## tmean_wettest_month 3.684748e-16 2.328410e-04
## tmean_driest_month 4.052632e-19 4.678189e-03
## ann_ppt 3.541662e-03 1.032132e-10
## ppt_seasonality 1.904144e-10 3.190965e-01
## ppt_warmest_month 0.000000e+00 7.565041e-02
## ppt_coldest_month 7.565041e-02 0.000000e+00#ann_ppt and ppt 100% correlated (ppt = avg across monts, ann_ppt = avg of the total ppt in a year) - only keep ann_ppt
#tmn, tmx, tmean_wettest_month, tmean_driest_month and ann_tmean all highly correlated (97-99%) - only keep ann_tmean
#ppt warmest month highly neg correlated with tmn, ann_tmean, tmean_driest - take it out
#temp ann range and mean diurnal range highly corr - keep temp_ann_range
wtr_yr_avgs <- all_clim_avgs %>%
filter(Season=="Water Year") %>%
ungroup()
wtr_yr_avgs.pc = prcomp(wtr_yr_avgs[c(8:9, 13, 15:16, 19:20, 22)], scale = TRUE, center = TRUE)
summary(wtr_yr_avgs.pc)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.0049 1.2082 1.0645 0.84647 0.61935 0.43145 0.29412
## Proportion of Variance 0.5025 0.1825 0.1417 0.08956 0.04795 0.02327 0.01081
## Cumulative Proportion 0.5025 0.6849 0.8266 0.91615 0.96410 0.98737 0.99818
## PC8
## Standard deviation 0.12057
## Proportion of Variance 0.00182
## Cumulative Proportion 1.00000tibble(PC=str_c("PC",str_pad(1:8,2,pad="0")),
percent_var=wtr_yr_avgs.pc$sdev[1:8]^2/sum(wtr_yr_avgs.pc$sdev^2)*100) %>%
ggplot(aes(x=PC, y=percent_var)) +
geom_col() +
ggtitle("Percent Variance Explained")
#combine pcs with metadata
wtr_yr_avgs.pc.dat = data.frame(wtr_yr_avgs.pc$x)
wtr_yr_avgs_locs.pc = cbind(wtr_yr_avgs, wtr_yr_avgs.pc.dat)
wtr_yr_avgs_loadings = data.frame(varnames=rownames(wtr_yr_avgs.pc$rotation), wtr_yr_avgs.pc$rotation)
wtr_yr_avgs_loadings## varnames PC1 PC2 PC3
## cwd cwd -0.2883385 -0.3473952 0.37741110
## pck pck 0.4349608 -0.2904655 -0.05643197
## ann_tmean ann_tmean -0.4033523 0.2757794 -0.05398867
## temp_seasonality temp_seasonality -0.2581799 0.2512527 -0.60426764
## temp_ann_range temp_ann_range -0.2416149 -0.4173999 -0.61961564
## ann_ppt ann_ppt 0.4292284 0.1965747 -0.23663127
## ppt_seasonality ppt_seasonality -0.3511527 0.4548416 0.20883693
## ppt_coldest_month ppt_coldest_month 0.3638642 0.4858179 -0.05283346
## PC4 PC5 PC6 PC7 PC8
## cwd 0.57743481 0.3905207 0.4062419 -0.02610130 0.04568685
## pck 0.23720501 0.2233428 -0.3558512 0.56028891 -0.42018138
## ann_tmean -0.43696683 0.4240691 0.2847712 0.29722857 -0.46703730
## temp_seasonality 0.48995528 -0.3030735 0.2041767 0.35765103 0.05969711
## temp_ann_range -0.02817636 0.3457510 -0.2657792 -0.43403266 -0.06415091
## ann_ppt -0.08541412 0.5560173 0.2230052 0.13600852 0.58004018
## ppt_seasonality 0.23163337 0.2785809 -0.6713289 0.04761772 0.20490668
## ppt_coldest_month 0.34287483 0.1400611 0.1204255 -0.50988809 -0.46596571Permanova
wtr_yr_avgs_locs.pc_dist <- wtr_yr_avgs_locs.pc %>% ungroup() %>% select(PC1:PC8)
dist_matrix_wtr_year <- dist(wtr_yr_avgs_locs.pc_dist, method = "euclidian") #use a distance function to calculate euclidian distance in PCA space
permanova_results_wtr_year <- adonis2(dist_matrix_wtr_year ~ timeframe*elev_m*Lat, data = wtr_yr_avgs_locs.pc) #use adonis2 to run the permanova
permanova_results_wtr_year #look at output ## Permutation test for adonis under reduced model
## Permutation: free
## Number of permutations: 999
##
## adonis2(formula = dist_matrix_wtr_year ~ timeframe * elev_m * Lat, data = wtr_yr_avgs_locs.pc)
## Df SumOfSqs R2 F Pr(>F)
## Model 7 231.29 0.64246 9.7547 0.001 ***
## Residual 38 128.71 0.35754
## Total 45 360.00 1.00000
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#get stats per term in the model:
permanova_results_wtr_year_terms <- adonis2(dist_matrix_wtr_year ~ timeframe*elev_m*Lat, data = wtr_yr_avgs_locs.pc, by = "terms")
permanova_results_wtr_year_terms## Permutation test for adonis under reduced model
## Terms added sequentially (first to last)
## Permutation: free
## Number of permutations: 999
##
## adonis2(formula = dist_matrix_wtr_year ~ timeframe * elev_m * Lat, data = wtr_yr_avgs_locs.pc, by = "terms")
## Df SumOfSqs R2 F Pr(>F)
## timeframe 1 32.63 0.09064 9.6338 0.001 ***
## elev_m 1 122.98 0.34161 36.3073 0.001 ***
## Lat 1 58.94 0.16373 17.4016 0.001 ***
## timeframe:elev_m 1 3.25 0.00903 0.9595 0.403
## timeframe:Lat 1 3.64 0.01012 1.0754 0.369
## elev_m:Lat 1 9.52 0.02644 2.8100 0.039 *
## timeframe:elev_m:Lat 1 0.32 0.00089 0.0951 0.995
## Residual 38 128.71 0.35754
## Total 45 360.00 1.00000
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#LM on PCs (follow up on permanova)
lmer_results_wtr_year <- wtr_yr_avgs_locs.pc %>%
ungroup() %>%
select(timeframe, parent.pop, elev_m, Lat, Long, PC1:PC8) %>%
pivot_longer(starts_with("PC", ignore.case = FALSE),
names_to = "PC", values_to = "value") %>%
group_by(PC) %>%
nest(data=c(timeframe, parent.pop, elev_m, Lat, Long, value)) %>%
mutate(glm=map(data, ~ glm(value ~ timeframe*elev_m*Lat,
data=.x)),
anova = map(glm, ~ broom.mixed::tidy(anova(.x))))
PC_anova_wtr_yr <- lmer_results_wtr_year %>% select(-data, -glm) %>% unnest(anova) %>%
select(PC, term, p.value) %>%
filter(p.value < 0.05) %>%
arrange(term, p.value)
PC_anova_wtr_yr #PC2 and PC4 most sig, PC1 and PC7 also have sig timeframe effects ## # A tibble: 12 × 3
## # Groups: PC [6]
## PC term p.value
## <chr> <chr> <dbl>
## 1 PC3 Lat 1.90e- 7
## 2 PC1 Lat 2.77e- 7
## 3 PC5 Lat 5.79e- 3
## 4 PC1 elev_m 4.61e-14
## 5 PC4 elev_m 1.02e- 4
## 6 PC5 elev_m 3.44e- 2
## 7 PC7 elev_m:Lat 8.07e- 4
## 8 PC5 elev_m:Lat 2.63e- 3
## 9 PC4 timeframe 7.35e- 6
## 10 PC2 timeframe 2.83e- 4
## 11 PC7 timeframe 6.63e- 3
## 12 PC1 timeframe 3.21e- 2lmer_results_wtr_year %>% select(-data, -glm) %>% unnest(anova) %>% filter(PC=="PC1" | PC=="PC2" |PC=="PC3" | PC=="PC4") ## # A tibble: 32 × 8
## # Groups: PC [4]
## PC term df deviance df.residual residual.deviance statistic p.value
## <chr> <chr> <int> <dbl> <int> <dbl> <dbl> <dbl>
## 1 PC1 NULL NA NA 45 181. NA NA
## 2 PC1 timef… 1 4.07 44 177. 4.95 3.21e- 2
## 3 PC1 elev_m 1 111. 43 66.2 135. 4.61e-14
## 4 PC1 Lat 1 31.8 42 34.4 38.8 2.77e- 7
## 5 PC1 timef… 1 0.651 41 33.7 0.793 3.79e- 1
## 6 PC1 timef… 1 0.550 40 33.1 0.671 4.18e- 1
## 7 PC1 elev_… 1 1.92 39 31.2 2.34 1.34e- 1
## 8 PC1 timef… 1 0.0365 38 31.2 0.0445 8.34e- 1
## 9 PC2 NULL NA NA 45 65.7 NA NA
## 10 PC2 timef… 1 17.6 44 48.1 16.0 2.83e- 4
## # ℹ 22 more rowsPlot climate change PCA
#prep the pc for making a plot with arrows distinguishing recent vs. historical time
wtr_yr_avgs_locs.pc_avg <- wtr_yr_avgs_locs.pc %>%
group_by(parent.pop, elev_m, timeframe) %>%
summarise(across(.cols=starts_with("PC", ignore.case = FALSE), .fns = mean)) %>%
ungroup()## `summarise()` has grouped output by 'parent.pop', 'elev_m'. You can override
## using the `.groups` argument.autoplot(wtr_yr_avgs.pc, data = wtr_yr_avgs,
x=1, y=2,
colour='elev_m', alpha=0.5,
label=TRUE, label.label="parent.pop",
loadings=TRUE, loadings.colour='black', loadings.linewidth = 0.7,
loadings.label = TRUE, loadings.label.size=6, loadings.label.colour="black",
loadings.label.vjust = -0.2, loadings.label.repel=TRUE) +
scale_colour_gradient(low = "#F5A540", high = "#0043F0") +
geom_vline(xintercept = 0, linetype="dashed") + geom_hline(yintercept = 0, linetype="dashed") +
theme_classic()
autoplot(wtr_yr_avgs.pc, data = wtr_yr_avgs,
x=2, y=4,
colour='elev_m', alpha=0.5,
label=TRUE, label.label="parent.pop",
loadings=TRUE, loadings.colour='black', loadings.linewidth = 0.7,
loadings.label = TRUE, loadings.label.size=6, loadings.label.colour="black",
loadings.label.vjust = -0.2, loadings.label.repel=TRUE) +
scale_colour_gradient(low = "#F5A540", high = "#0043F0") +
geom_vline(xintercept = 0, linetype="dashed") + geom_hline(yintercept = 0, linetype="dashed") +
theme_classic()
autoplot(wtr_yr_avgs.pc, data = wtr_yr_avgs,
x=1, y=4,
colour='elev_m', alpha=0.5,
label=TRUE, label.label="parent.pop",
loadings=TRUE, loadings.colour='black', loadings.linewidth = 0.7,
loadings.label = TRUE, loadings.label.size=6, loadings.label.colour="black",
loadings.label.vjust = -0.2, loadings.label.repel=TRUE) +
scale_colour_gradient(low = "#F5A540", high = "#0043F0") +
geom_vline(xintercept = 0, linetype="dashed") + geom_hline(yintercept = 0, linetype="dashed") +
theme_classic()
wtr_yr_avgs_locs.pc_avg %>%
mutate(group=str_c(parent.pop,elev_m)) %>%
ggplot(aes(x=PC1, y=PC2, shape=timeframe, color=elev_m)) +
scale_colour_gradient(low = "#F5A540", high = "#0043F0") +
geom_point(size=2, alpha=0.7) +
geom_text_repel(aes(label = parent.pop)) +
geom_vline(xintercept = 0, linetype="dashed") + geom_hline(yintercept = 0, linetype="dashed") +
geom_path(aes(group=group),arrow = arrow(length=unit(5, "points")), linewidth = .8)
wtr_yr_avgs_locs.pc_avg %>%
mutate(group=str_c(parent.pop,elev_m)) %>%
ggplot(aes(x=PC2, y=PC4, shape=timeframe, color=elev_m)) +
scale_colour_gradient(low = "#F5A540", high = "#0043F0") +
geom_point(size=2, alpha=0.7) +
geom_text_repel(aes(label = parent.pop)) +
geom_vline(xintercept = 0, linetype="dashed") + geom_hline(yintercept = 0, linetype="dashed") +
geom_path(aes(group=group),arrow = arrow(length=unit(5, "points")), linewidth = .8)
wtr_yr_avgs_locs.pc_avg %>%
mutate(group=str_c(parent.pop,elev_m)) %>%
ggplot(aes(x=PC1, y=PC4, shape=timeframe, color=elev_m)) +
scale_colour_gradient(low = "#F5A540", high = "#0043F0") +
geom_point(size=2, alpha=0.7) +
geom_text_repel(aes(label = parent.pop)) +
geom_vline(xintercept = 0, linetype="dashed") + geom_hline(yintercept = 0, linetype="dashed") +
geom_path(aes(group=group),arrow = arrow(length=unit(5, "points")), linewidth = .8)
#wtr_yr_avgs_locs.pc_avg %>% filter(parent.pop=="WL2")
#wtr_yr_avgs_loadings#PC1 = positive PPT and PCK, negative ANN_TMEAN
#PC2 = positive ppt_seasonality and ppt_coldest month, negative temp_ann_range
#PC4 = positive CWD and temp_seasonality and negative ann_tmean
home_sites_pca_wtryr <- wtr_yr_avgs_locs.pc_avg %>%
mutate(group=str_c(parent.pop,elev_m)) %>%
ggplot(aes(x=PC1, y=PC2, shape=timeframe, color=elev_m)) +
scale_colour_gradient(low = "#F5A540", high = "#0043F0") +
labs(x="PC1 (50.25%)", y="PC2 (18.25%)", color="Elevation (m)") +
geom_vline(xintercept = 0, linetype="dashed") + geom_hline(yintercept = 0, linetype="dashed") +
annotate("text", x = 1.3, y= 1.16, label = "WL2", colour = "purple", size=7) +
geom_path(aes(group=group),arrow = arrow(length=unit(5, "points")), linewidth = .8) +
annotate("text", x = -4.5, y = -5.4, label = "Warm \n No Snow", size=6) +
annotate("text", x = 4.5, y = -5.4, label = "Cold \n Snow", size=6) +
annotate("text", x = -6.2, y = -3, label = "Low PPT \n Seasonality", size=6) +
annotate("text", x = -6.2, y = 3, label = "High PPT \n Seasonality", size=6) +
coord_cartesian(ylim = c(-4, 4), xlim = c(-5,5), clip = "off") +
theme_classic() +
theme(text=element_text(size=28))
## add WL2 garden 2023 and 2024
WL2GRDN_wtryr_pc_prep_2023 <- all_clim %>%
ungroup() %>%
filter(parent.pop=="WL2_Garden", year==2023, Season=="Water Year") %>%
select(cwd:pck, ann_tmean, temp_seasonality, temp_ann_range, ann_ppt, ppt_seasonality, ppt_coldest_month)
WL2GRDN_wtryr_predicted_2023 <- predict(wtr_yr_avgs.pc, newdata = WL2GRDN_wtryr_pc_prep_2023)
WL2GRDN_wtryr_pc_prep_2024 <- all_clim %>%
ungroup() %>%
filter(parent.pop=="WL2_Garden", year==2024, Season=="Water Year") %>%
select(cwd:pck, ann_tmean, temp_seasonality, temp_ann_range, ann_ppt, ppt_seasonality, ppt_coldest_month)
WL2GRDN_wtryr_2024_predicted <- predict(wtr_yr_avgs.pc, newdata = WL2GRDN_wtryr_pc_prep_2024)
home_sites_pca_wtryr$data <- rbind(home_sites_pca_wtryr$data,
data.frame(
parent.pop = "WL2_Garden",
elev_m = 2020,
timeframe = c("2023", "2024"),
PC1 = c(WL2GRDN_wtryr_predicted_2023[, "PC1"], WL2GRDN_wtryr_2024_predicted[, "PC1"]),
PC2 = c(WL2GRDN_wtryr_predicted_2023[, "PC2"], WL2GRDN_wtryr_2024_predicted[, "PC2"]),
PC3 = c(WL2GRDN_wtryr_predicted_2023[, "PC3"], WL2GRDN_wtryr_2024_predicted[, "PC3"]),
PC4 = c(WL2GRDN_wtryr_predicted_2023[, "PC4"], WL2GRDN_wtryr_2024_predicted[, "PC4"]),
PC5 = c(WL2GRDN_wtryr_predicted_2023[, "PC5"], WL2GRDN_wtryr_2024_predicted[, "PC5"]),
PC6 = c(WL2GRDN_wtryr_predicted_2023[, "PC6"], WL2GRDN_wtryr_2024_predicted[, "PC6"]),
PC7 = c(WL2GRDN_wtryr_predicted_2023[, "PC7"], WL2GRDN_wtryr_2024_predicted[, "PC7"]),
PC8 = c(WL2GRDN_wtryr_predicted_2023[, "PC8"], WL2GRDN_wtryr_2024_predicted[, "PC8"]),
group = c("new", "new2")
)
)
home_sites_pca_wtryr +
geom_point(data=filter(home_sites_pca_wtryr$data, parent.pop == "WL2_Garden"), size=6, shape = 18, show.legend = FALSE) +
annotate("text", x = 4.49, y= 2.7, label = "WL2 \n Garden \n 2023", colour = "purple", size=6) +
annotate("text", x = -0.71, y= 1.9, label = "WL2 \n Garden \n 2024", colour = "purple", size=6) 
ggsave("../Figures/Wtr_Year_PC1-PC2_PlusGarden.png", width = 7.4, height = 6, units = "in")Growth Season PCA
grwssn_avgs_normalized <- all_clim_avgs %>%
filter(Season=="Growth Season") %>%
ungroup() %>%
select(cwd:ppt_coldest_month) %>%
scale() #center and scale the data
cor.norm_grwssn = cor(grwssn_avgs_normalized) #test correlations among the traits
cor.sig_grwssn <- cor.mtest(grwssn_avgs_normalized, method = "pearson") #get pearson's test p-values
cor.norm_grwssn## cwd pck ppt tmn tmx
## cwd 1.00000000 0.2451066 -0.72857067 -0.3682706 -0.33727778
## pck 0.24510659 1.0000000 0.13194309 -0.8378476 -0.77049664
## ppt -0.72857067 0.1319431 1.00000000 0.1254422 0.15268049
## tmn -0.36827062 -0.8378476 0.12544222 1.0000000 0.91377238
## tmx -0.33727778 -0.7704966 0.15268049 0.9137724 1.00000000
## ann_tmean -0.36120137 -0.8233208 0.14164723 0.9797849 0.97656763
## mean_diurnal_range 0.13466606 0.2991502 0.04055125 -0.3704043 0.03886672
## temp_seasonality 0.29743512 -0.2005587 -0.46077431 0.4019525 0.43396829
## temp_ann_range -0.01041239 -0.6192414 -0.19084644 0.6804142 0.86403889
## tmean_wettest_month -0.59345820 -0.7715523 0.43757202 0.7495849 0.76191387
## tmean_driest_month -0.49369595 -0.7826338 0.30437863 0.9280001 0.95402569
## ann_ppt -0.73526218 -0.5147399 0.71140138 0.7325118 0.72943167
## ppt_seasonality 0.45598307 0.1806485 -0.43357048 0.1007506 0.03865398
## ppt_warmest_month 0.20339923 0.8549983 0.11170738 -0.9135610 -0.85180553
## ppt_coldest_month -0.28231559 0.3261477 0.54381864 0.1574778 0.15001140
## ann_tmean mean_diurnal_range temp_seasonality
## cwd -0.36120137 0.134666060 0.297435123
## pck -0.82332083 0.299150223 -0.200558737
## ppt 0.14164723 0.040551245 -0.460774305
## tmn 0.97978485 -0.370404313 0.401952542
## tmx 0.97656763 0.038866724 0.433968286
## ann_tmean 1.00000000 -0.177092153 0.426662476
## mean_diurnal_range -0.17709215 1.000000000 0.003573292
## temp_seasonality 0.42666248 0.003573292 1.000000000
## temp_ann_range 0.78598247 0.301999527 0.683579289
## tmean_wettest_month 0.77233426 -0.101665082 -0.175366923
## tmean_driest_month 0.96146424 -0.101254889 0.267312613
## ann_ppt 0.74729280 -0.133941578 0.027897560
## ppt_seasonality 0.07241155 -0.159442800 0.731753824
## ppt_warmest_month -0.90347441 0.299472091 -0.471146212
## ppt_coldest_month 0.15730462 -0.044353766 0.233607554
## temp_ann_range tmean_wettest_month tmean_driest_month
## cwd -0.01041239 -0.5934582 -0.4936959
## pck -0.61924138 -0.7715523 -0.7826338
## ppt -0.19084644 0.4375720 0.3043786
## tmn 0.68041422 0.7495849 0.9280001
## tmx 0.86403889 0.7619139 0.9540257
## ann_tmean 0.78598247 0.7723343 0.9614642
## mean_diurnal_range 0.30199953 -0.1016651 -0.1012549
## temp_seasonality 0.68357929 -0.1753669 0.2673126
## temp_ann_range 1.00000000 0.4572525 0.7322762
## tmean_wettest_month 0.45725255 1.0000000 0.8777016
## tmean_driest_month 0.73227618 0.8777016 1.0000000
## ann_ppt 0.40566549 0.7780776 0.8168684
## ppt_seasonality 0.20038818 -0.5126221 -0.1363698
## ppt_warmest_month -0.73452496 -0.6676225 -0.8500851
## ppt_coldest_month -0.01213333 -0.1185820 0.1212578
## ann_ppt ppt_seasonality ppt_warmest_month
## cwd -0.73526218 0.45598307 0.20339923
## pck -0.51473990 0.18064845 0.85499827
## ppt 0.71140138 -0.43357048 0.11170738
## tmn 0.73251177 0.10075058 -0.91356095
## tmx 0.72943167 0.03865398 -0.85180553
## ann_tmean 0.74729280 0.07241155 -0.90347441
## mean_diurnal_range -0.13394158 -0.15944280 0.29947209
## temp_seasonality 0.02789756 0.73175382 -0.47114621
## temp_ann_range 0.40566549 0.20038818 -0.73452496
## tmean_wettest_month 0.77807755 -0.51262206 -0.66762252
## tmean_driest_month 0.81686835 -0.13636981 -0.85008506
## ann_ppt 1.00000000 -0.25108665 -0.55006980
## ppt_seasonality -0.25108665 1.00000000 -0.17433133
## ppt_warmest_month -0.55006980 -0.17433133 1.00000000
## ppt_coldest_month 0.45931956 0.41876861 0.02006087
## ppt_coldest_month
## cwd -0.28231559
## pck 0.32614770
## ppt 0.54381864
## tmn 0.15747785
## tmx 0.15001140
## ann_tmean 0.15730462
## mean_diurnal_range -0.04435377
## temp_seasonality 0.23360755
## temp_ann_range -0.01213333
## tmean_wettest_month -0.11858197
## tmean_driest_month 0.12125776
## ann_ppt 0.45931956
## ppt_seasonality 0.41876861
## ppt_warmest_month 0.02006087
## ppt_coldest_month 1.00000000cor.sig_grwssn$p## cwd pck ppt tmn
## cwd 0.000000e+00 1.006324e-01 9.480850e-09 1.179598e-02
## pck 1.006324e-01 0.000000e+00 3.820724e-01 3.835160e-13
## ppt 9.480850e-09 3.820724e-01 0.000000e+00 4.061630e-01
## tmn 1.179598e-02 3.835160e-13 4.061630e-01 0.000000e+00
## tmx 2.189439e-02 3.803463e-10 3.110669e-01 7.959186e-19
## ann_tmean 1.365318e-02 2.162030e-12 3.477279e-01 2.171258e-32
## mean_diurnal_range 3.722387e-01 4.342401e-02 7.890281e-01 1.127979e-02
## temp_seasonality 4.469927e-02 1.814036e-01 1.270760e-03 5.622943e-03
## temp_ann_range 9.452455e-01 4.476642e-06 2.039150e-01 1.971043e-07
## tmean_wettest_month 1.381051e-05 3.477532e-10 2.357743e-03 2.046175e-09
## tmean_driest_month 4.891973e-04 1.318233e-10 3.971841e-02 1.747231e-20
## ann_ppt 5.910050e-09 2.522583e-04 2.999560e-08 7.189403e-09
## ppt_seasonality 1.448894e-03 2.295909e-01 2.611760e-03 5.052727e-01
## ppt_warmest_month 1.751701e-01 3.945830e-14 4.598440e-01 8.381202e-19
## ppt_coldest_month 5.731093e-02 2.696386e-02 9.380478e-05 2.959249e-01
## tmx ann_tmean mean_diurnal_range
## cwd 2.189439e-02 1.365318e-02 0.37223870
## pck 3.803463e-10 2.162030e-12 0.04342401
## ppt 3.110669e-01 3.477279e-01 0.78902807
## tmn 7.959186e-19 2.171258e-32 0.01127979
## tmx 0.000000e+00 5.415031e-31 0.79760401
## ann_tmean 5.415031e-31 0.000000e+00 0.23904532
## mean_diurnal_range 7.976040e-01 2.390453e-01 0.00000000
## temp_seasonality 2.585470e-03 3.107460e-03 0.98119693
## temp_ann_range 1.054861e-14 9.724161e-11 0.04137112
## tmean_wettest_month 7.745853e-10 3.253247e-10 0.50139580
## tmean_driest_month 1.183205e-24 2.629175e-26 0.50313286
## ann_ppt 8.928422e-09 2.436166e-09 0.37484018
## ppt_seasonality 7.986888e-01 6.324853e-01 0.28986284
## ppt_warmest_month 6.156080e-14 8.548681e-18 0.04318803
## ppt_coldest_month 3.197013e-01 2.964632e-01 0.76976130
## temp_seasonality temp_ann_range tmean_wettest_month
## cwd 4.469927e-02 9.452455e-01 1.381051e-05
## pck 1.814036e-01 4.476642e-06 3.477532e-10
## ppt 1.270760e-03 2.039150e-01 2.357743e-03
## tmn 5.622943e-03 1.971043e-07 2.046175e-09
## tmx 2.585470e-03 1.054861e-14 7.745853e-10
## ann_tmean 3.107460e-03 9.724161e-11 3.253247e-10
## mean_diurnal_range 9.811969e-01 4.137112e-02 5.013958e-01
## temp_seasonality 0.000000e+00 1.643360e-07 2.437260e-01
## temp_ann_range 1.643360e-07 0.000000e+00 1.399654e-03
## tmean_wettest_month 2.437260e-01 1.399654e-03 0.000000e+00
## tmean_driest_month 7.250297e-02 7.310283e-09 1.187604e-15
## ann_ppt 8.539829e-01 5.157823e-03 1.977458e-10
## ppt_seasonality 7.585129e-09 1.817829e-01 2.701735e-04
## ppt_warmest_month 9.503378e-04 6.230226e-09 4.019715e-07
## ppt_coldest_month 1.181686e-01 9.362131e-01 4.325101e-01
## tmean_driest_month ann_ppt ppt_seasonality
## cwd 4.891973e-04 5.910050e-09 1.448894e-03
## pck 1.318233e-10 2.522583e-04 2.295909e-01
## ppt 3.971841e-02 2.999560e-08 2.611760e-03
## tmn 1.747231e-20 7.189403e-09 5.052727e-01
## tmx 1.183205e-24 8.928422e-09 7.986888e-01
## ann_tmean 2.629175e-26 2.436166e-09 6.324853e-01
## mean_diurnal_range 5.031329e-01 3.748402e-01 2.898628e-01
## temp_seasonality 7.250297e-02 8.539829e-01 7.585129e-09
## temp_ann_range 7.310283e-09 5.157823e-03 1.817829e-01
## tmean_wettest_month 1.187604e-15 1.977458e-10 2.701735e-04
## tmean_driest_month 0.000000e+00 4.435200e-12 3.661636e-01
## ann_ppt 4.435200e-12 0.000000e+00 9.234216e-02
## ppt_seasonality 3.661636e-01 9.234216e-02 0.000000e+00
## ppt_warmest_month 7.789956e-14 7.492518e-05 2.465653e-01
## ppt_coldest_month 4.221219e-01 1.322662e-03 3.773652e-03
## ppt_warmest_month ppt_coldest_month
## cwd 1.751701e-01 5.731093e-02
## pck 3.945830e-14 2.696386e-02
## ppt 4.598440e-01 9.380478e-05
## tmn 8.381202e-19 2.959249e-01
## tmx 6.156080e-14 3.197013e-01
## ann_tmean 8.548681e-18 2.964632e-01
## mean_diurnal_range 4.318803e-02 7.697613e-01
## temp_seasonality 9.503378e-04 1.181686e-01
## temp_ann_range 6.230226e-09 9.362131e-01
## tmean_wettest_month 4.019715e-07 4.325101e-01
## tmean_driest_month 7.789956e-14 4.221219e-01
## ann_ppt 7.492518e-05 1.322662e-03
## ppt_seasonality 2.465653e-01 3.773652e-03
## ppt_warmest_month 0.000000e+00 8.947247e-01
## ppt_coldest_month 8.947247e-01 0.000000e+00#tmn, tmx, tmean_driest_month and ann_tmean all highly correlated (90-98%) - only keep ann_tmean
#ppt_warmest_month highly neg corr with tmn, ann_tmean - take it out
grwssn_avgs <- all_clim_avgs %>%
filter(Season=="Growth Season") %>%
ungroup()
grwssn_avgs.pc = prcomp(grwssn_avgs[c(8:10, 13:17, 19:20, 22)], scale = TRUE, center = TRUE)
summary(grwssn_avgs.pc)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.0650 1.7146 1.4002 1.1146 0.54609 0.37391 0.29362
## Proportion of Variance 0.3876 0.2673 0.1782 0.1129 0.02711 0.01271 0.00784
## Cumulative Proportion 0.3876 0.6549 0.8331 0.9461 0.97318 0.98589 0.99373
## PC8 PC9 PC10 PC11
## Standard deviation 0.20060 0.12653 0.10516 0.04057
## Proportion of Variance 0.00366 0.00146 0.00101 0.00015
## Cumulative Proportion 0.99739 0.99884 0.99985 1.00000tibble(PC=str_c("PC",str_pad(1:11,2,pad="0")),
percent_var=grwssn_avgs.pc$sdev[1:11]^2/sum(grwssn_avgs.pc$sdev^2)*100) %>%
ggplot(aes(x=PC, y=percent_var)) +
geom_col() +
ggtitle("Percent Variance Explained")
#combine pcs with metadata
grwssn_avgs.pc.dat = data.frame(grwssn_avgs.pc$x)
grwssn_avgs_locs.pc = cbind(grwssn_avgs, grwssn_avgs.pc.dat)
grwssn_avgs_loadings = data.frame(varnames=rownames(grwssn_avgs.pc$rotation), grwssn_avgs.pc$rotation)
grwssn_avgs_loadings## varnames PC1 PC2 PC3
## cwd cwd 0.34735290 0.28128485 0.13039565
## pck pck 0.35486850 -0.23817987 -0.33233268
## ppt ppt -0.25886540 -0.40007940 -0.31081500
## ann_tmean ann_tmean -0.41670860 0.28025294 -0.01798899
## mean_diurnal_range mean_diurnal_range 0.06793477 -0.00876756 0.02040727
## temp_seasonality temp_seasonality -0.01061264 0.52475785 -0.23395704
## temp_ann_range temp_ann_range -0.25821756 0.42908856 0.03980511
## tmean_wettest_month tmean_wettest_month -0.44900711 -0.04383096 0.21511238
## ann_ppt ann_ppt -0.45271873 -0.06190265 -0.21013037
## ppt_seasonality ppt_seasonality 0.16624338 0.39869553 -0.39462543
## ppt_coldest_month ppt_coldest_month -0.08458365 -0.03560988 -0.68755237
## PC4 PC5 PC6 PC7
## cwd -0.0418492646 0.827863235 0.302816094 -0.03010015
## pck -0.1982010790 -0.051012506 0.074657652 -0.51751706
## ppt -0.1163065695 0.210209948 0.130072306 -0.43377306
## ann_tmean 0.0477923303 0.163390973 -0.199000974 -0.06956301
## mean_diurnal_range -0.8817906730 0.002429217 -0.242758592 0.18620414
## temp_seasonality -0.0444375108 -0.347188547 0.510494316 -0.22972460
## temp_ann_range -0.3597626954 -0.058404233 0.068452467 -0.11018798
## tmean_wettest_month -0.0154751276 0.244307534 -0.209323247 -0.36054287
## ann_ppt -0.0079454364 0.109344823 0.289827979 0.16615026
## ppt_seasonality 0.1840971801 0.063456814 -0.627822821 -0.22002218
## ppt_coldest_month -0.0007647201 0.203787351 -0.002925931 0.48236749
## PC8 PC9 PC10 PC11
## cwd -0.05091135 0.01442390 0.02173586 -0.01538845
## pck 0.36172191 -0.02701541 -0.24277470 -0.44843945
## ppt -0.28024265 -0.25831211 0.33215622 0.39741296
## ann_tmean 0.41414633 -0.24213862 0.53408690 -0.39833454
## mean_diurnal_range -0.14252875 0.21766423 0.22530657 -0.07260801
## temp_seasonality -0.02219047 0.39174931 0.25874517 0.11392648
## temp_ann_range 0.09413240 -0.52876068 -0.50855069 0.22557106
## tmean_wettest_month 0.20287518 0.60826634 -0.28711941 0.15126549
## ann_ppt -0.47589035 0.06949634 -0.25647143 -0.57127445
## ppt_seasonality -0.41267243 0.03236594 -0.07313108 -0.02217544
## ppt_coldest_month 0.38589623 0.13193755 -0.12293171 0.25138980Permanova
grwssn_avgs_locs.pc_dist <- grwssn_avgs_locs.pc %>% ungroup() %>% select(PC1:PC11)
dist_matrix_grwssn <- dist(grwssn_avgs_locs.pc_dist, method = "euclidian") #use a distance function to calculate euclidian distance in PCA space
permanova_results_grwssn <- adonis2(dist_matrix_grwssn ~ timeframe*elev_m*Lat, data = grwssn_avgs_locs.pc) #use adonis2 to run the permanova
permanova_results_grwssn #look at output ## Permutation test for adonis under reduced model
## Permutation: free
## Number of permutations: 999
##
## adonis2(formula = dist_matrix_grwssn ~ timeframe * elev_m * Lat, data = grwssn_avgs_locs.pc)
## Df SumOfSqs R2 F Pr(>F)
## Model 7 289.06 0.58396 7.6196 0.001 ***
## Residual 38 205.94 0.41604
## Total 45 495.00 1.00000
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#get stats per term in the model:
permanova_results_grwssn_terms <- adonis2(dist_matrix_grwssn ~ timeframe*elev_m*Lat, data = grwssn_avgs_locs.pc, by = "terms")
permanova_results_grwssn_terms## Permutation test for adonis under reduced model
## Terms added sequentially (first to last)
## Permutation: free
## Number of permutations: 999
##
## adonis2(formula = dist_matrix_grwssn ~ timeframe * elev_m * Lat, data = grwssn_avgs_locs.pc, by = "terms")
## Df SumOfSqs R2 F Pr(>F)
## timeframe 1 18.71 0.03779 3.4520 0.014 *
## elev_m 1 176.22 0.35600 32.5159 0.001 ***
## Lat 1 59.16 0.11952 10.9164 0.001 ***
## timeframe:elev_m 1 9.27 0.01873 1.7106 0.162
## timeframe:Lat 1 2.30 0.00464 0.4242 0.802
## elev_m:Lat 1 22.53 0.04551 4.1567 0.003 **
## timeframe:elev_m:Lat 1 0.88 0.00177 0.1616 0.980
## Residual 38 205.94 0.41604
## Total 45 495.00 1.00000
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#LM on PCs (follow up on permanova)
lmer_results_grwssn <- grwssn_avgs_locs.pc %>%
ungroup() %>%
select(timeframe, parent.pop, elev_m, Lat, Long, PC1:PC11) %>%
pivot_longer(starts_with("PC", ignore.case = FALSE),
names_to = "PC", values_to = "value") %>%
group_by(PC) %>%
nest(data=c(timeframe, parent.pop, elev_m, Lat, Long, value)) %>%
mutate(glm=map(data, ~ glm(value ~ timeframe*elev_m*Lat,
data=.x)),
anova = map(glm, ~ broom.mixed::tidy(anova(.x))))
PC_anova_grwssn <- lmer_results_grwssn %>% select(-data, -glm) %>% unnest(anova) %>%
select(PC, term, p.value) %>%
filter(p.value < 0.05) %>%
arrange(term, p.value)
PC_anova_grwssn #PC2 and PC4 most sig, PC7 also has sig timeframe effects ## # A tibble: 15 × 3
## # Groups: PC [8]
## PC term p.value
## <chr> <chr> <dbl>
## 1 PC4 Lat 8.41e- 6
## 2 PC2 Lat 1.90e- 3
## 3 PC3 Lat 2.39e- 3
## 4 PC1 elev_m 4.22e-20
## 5 PC2 elev_m:Lat 1.85e- 3
## 6 PC8 elev_m:Lat 4.70e- 3
## 7 PC7 elev_m:Lat 6.19e- 3
## 8 PC10 elev_m:Lat 2.16e- 2
## 9 PC9 elev_m:Lat 3.35e- 2
## 10 PC4 timeframe 4.29e- 3
## 11 PC2 timeframe 2.82e- 2
## 12 PC7 timeframe 3.03e- 2
## 13 PC9 timeframe:Lat 4.04e- 3
## 14 PC2 timeframe:elev_m 4.75e- 2
## 15 PC9 timeframe:elev_m:Lat 2.15e- 2#PC2 also has a significant timeframe*elev_m effect
#PC9 has sig timeframe*lat and timeframe*elev*lat effects
lmer_results_grwssn %>% select(-data, -glm) %>% unnest(anova) %>% filter(PC=="PC1" | PC=="PC2" |PC=="PC3" | PC=="PC4") ## # A tibble: 32 × 8
## # Groups: PC [4]
## PC term df deviance df.residual residual.deviance statistic p.value
## <chr> <chr> <int> <dbl> <int> <dbl> <dbl> <dbl>
## 1 PC1 NULL NA NA 45 192. NA NA
## 2 PC1 timef… 1 3.68e-1 44 192. 0.691 4.11e- 1
## 3 PC1 elev_m 1 1.70e+2 43 21.2 320. 4.22e-20
## 4 PC1 Lat 1 9.51e-1 42 20.3 1.79 1.89e- 1
## 5 PC1 timef… 1 4.95e-2 41 20.2 0.0930 7.62e- 1
## 6 PC1 timef… 1 2.90e-3 40 20.2 0.00545 9.42e- 1
## 7 PC1 elev_… 1 9.51e-4 39 20.2 0.00179 9.67e- 1
## 8 PC1 timef… 1 1.34e-2 38 20.2 0.0251 8.75e- 1
## 9 PC2 NULL NA NA 45 132. NA NA
## 10 PC2 timef… 1 9.76e+0 44 123. 5.21 2.82e- 2
## # ℹ 22 more rowsPlot climate change PCA
#prep the pc for making a plot with arrows distinguishing recent vs. historical time
grwssn_avgs_locs.pc_avg <- grwssn_avgs_locs.pc %>%
group_by(parent.pop, elev_m, timeframe) %>%
summarise(across(.cols=starts_with("PC", ignore.case = FALSE), .fns = mean)) %>%
ungroup()## `summarise()` has grouped output by 'parent.pop', 'elev_m'. You can override
## using the `.groups` argument.autoplot(grwssn_avgs.pc, data = grwssn_avgs,
x=1, y=2,
colour='elev_m', alpha=0.5,
label=TRUE, label.label="parent.pop",
loadings=TRUE, loadings.colour='black', loadings.linewidth = 0.7,
loadings.label = TRUE, loadings.label.size=6, loadings.label.colour="black",
loadings.label.vjust = -0.2, loadings.label.repel=TRUE) +
scale_colour_gradient(low = "#F5A540", high = "#0043F0") +
geom_vline(xintercept = 0, linetype="dashed") + geom_hline(yintercept = 0, linetype="dashed") +
theme_classic()
autoplot(grwssn_avgs.pc, data = grwssn_avgs,
x=2, y=4,
colour='elev_m', alpha=0.5,
label=TRUE, label.label="parent.pop",
loadings=TRUE, loadings.colour='black', loadings.linewidth = 0.7,
loadings.label = TRUE, loadings.label.size=6, loadings.label.colour="black",
loadings.label.vjust = -0.2, loadings.label.repel=TRUE) +
scale_colour_gradient(low = "#F5A540", high = "#0043F0") +
geom_vline(xintercept = 0, linetype="dashed") + geom_hline(yintercept = 0, linetype="dashed") +
theme_classic()
grwssn_avgs_locs.pc_avg %>%
mutate(group=str_c(parent.pop,elev_m)) %>%
ggplot(aes(x=PC1, y=PC2, shape=timeframe, color=elev_m)) +
scale_colour_gradient(low = "#F5A540", high = "#0043F0") +
geom_point(size=2, alpha=0.7) +
geom_text_repel(aes(label = parent.pop)) +
geom_vline(xintercept = 0, linetype="dashed") + geom_hline(yintercept = 0, linetype="dashed") +
geom_path(aes(group=group),arrow = arrow(length=unit(5, "points")), linewidth = .8)
grwssn_avgs_locs.pc_avg %>%
mutate(group=str_c(parent.pop,elev_m)) %>%
ggplot(aes(x=PC2, y=PC4, shape=timeframe, color=elev_m)) +
scale_colour_gradient(low = "#F5A540", high = "#0043F0") +
geom_point(size=2, alpha=0.7) +
geom_text_repel(aes(label = parent.pop)) +
geom_vline(xintercept = 0, linetype="dashed") + geom_hline(yintercept = 0, linetype="dashed") +
geom_path(aes(group=group),arrow = arrow(length=unit(5, "points")), linewidth = .8)
#grwssn_avgs_locs.pc_avg %>% filter(parent.pop=="WL2")
#grwssn_avgs_loadings#PC1 = neg ann_tmean, tmean_wettest_month, ann_ppt
#PC2 = positive temp_seasonality and temp_ann_range, negative ppt
#PC4 = negative mean_diurnal_range
home_sites_pca_grwssn <- grwssn_avgs_locs.pc_avg %>%
mutate(group=str_c(parent.pop,elev_m)) %>%
ggplot(aes(x=PC1, y=PC2, shape=timeframe, color=elev_m)) +
scale_colour_gradient(low = "#F5A540", high = "#0043F0") +
labs(x="PC1 (38.76%)", y="PC2 (26.73%)", color="Elevation (m)") +
geom_vline(xintercept = 0, linetype="dashed") + geom_hline(yintercept = 0, linetype="dashed") +
annotate("text", x = 0.73, y= -0.15, label = "WL2", colour = "purple", size=7) +
geom_path(aes(group=group),arrow = arrow(length=unit(5, "points")), linewidth = .8) +
annotate("text", x = -4, y = -5.2, label = "Warm \n Wet", size=6) +
annotate("text", x = 3.5, y = -5.2, label = "Cold \n Dry", size=6) +
annotate("text", x = -5.4, y = -3, label = "Low Temp \n Seasonality", size=6) +
annotate("text", x = -5.4, y = 2.7, label = "High Temp \n Seasonality", size=6) +
coord_cartesian(ylim = c(-4, 3), xlim = c(-4.5,4), clip = "off") +
theme_classic() +
theme(text=element_text(size=28))
## add WL2 garden 2023 and 2024
WL2GRDN_grwssn_pc_prep_2023 <- all_clim %>%
ungroup() %>%
filter(parent.pop=="WL2_Garden", year==2023, Season=="Growth Season") %>%
select(cwd:ppt, ann_tmean, mean_diurnal_range, temp_seasonality, temp_ann_range, tmean_wettest_month, ann_ppt, ppt_seasonality, ppt_coldest_month)
WL2GRDN_grwssn_predicted_2023 <- predict(grwssn_avgs.pc, newdata = WL2GRDN_grwssn_pc_prep_2023)
WL2GRDN_grwssn_pc_prep_2024 <- all_clim %>%
ungroup() %>%
filter(parent.pop=="WL2_Garden", year==2024, Season=="Growth Season") %>%
select(cwd:ppt, ann_tmean, mean_diurnal_range, temp_seasonality, temp_ann_range, tmean_wettest_month, ann_ppt, ppt_seasonality, ppt_coldest_month)
WL2GRDN_grwssn_2024_predicted <- predict(grwssn_avgs.pc, newdata = WL2GRDN_grwssn_pc_prep_2024)
home_sites_pca_grwssn$data <- rbind(home_sites_pca_grwssn$data,
data.frame(
parent.pop = "WL2_Garden",
elev_m = 2020,
timeframe = c("2023", "2024"),
PC1 = c(WL2GRDN_grwssn_predicted_2023[, "PC1"], WL2GRDN_grwssn_2024_predicted[, "PC1"]),
PC2 = c(WL2GRDN_grwssn_predicted_2023[, "PC2"], WL2GRDN_grwssn_2024_predicted[, "PC2"]),
PC3 = c(WL2GRDN_grwssn_predicted_2023[, "PC3"], WL2GRDN_grwssn_2024_predicted[, "PC3"]),
PC4 = c(WL2GRDN_grwssn_predicted_2023[, "PC4"], WL2GRDN_grwssn_2024_predicted[, "PC4"]),
PC5 = c(WL2GRDN_grwssn_predicted_2023[, "PC5"], WL2GRDN_grwssn_2024_predicted[, "PC5"]),
PC6 = c(WL2GRDN_grwssn_predicted_2023[, "PC6"], WL2GRDN_grwssn_2024_predicted[, "PC6"]),
PC7 = c(WL2GRDN_grwssn_predicted_2023[, "PC7"], WL2GRDN_grwssn_2024_predicted[, "PC7"]),
PC8 = c(WL2GRDN_grwssn_predicted_2023[, "PC8"], WL2GRDN_grwssn_2024_predicted[, "PC8"]),
PC9 = c(WL2GRDN_grwssn_predicted_2023[, "PC9"], WL2GRDN_grwssn_2024_predicted[, "PC9"]),
PC10 = c(WL2GRDN_grwssn_predicted_2023[, "PC10"], WL2GRDN_grwssn_2024_predicted[, "PC10"]),
PC11 = c(WL2GRDN_grwssn_predicted_2023[, "PC11"], WL2GRDN_grwssn_2024_predicted[, "PC11"]),
group = c("new", "new2")
)
)
home_sites_pca_grwssn +
geom_point(data=filter(home_sites_pca_grwssn$data, parent.pop == "WL2_Garden"), size=6, shape = 18, show.legend = FALSE) +
annotate("text", x = -0.07, y= -2.6, label = "WL2 Garden \n 2023", colour = "purple", size=6) +
annotate("text", x = 1.5, y= 3, label = "WL2 Garden 2024", colour = "purple", size=6) 
ggsave("../Figures/Growth_Season_PC1-PC2_PlusGarden.png", width = 7.4, height = 6, units = "in")WL2 Yearly Variation PCAs (Figure S2)
Water Year
wl2_wtryr_var <- all_clim %>%
filter(parent.pop=="WL2", Season=="Water Year") %>%
ungroup()
wl2_wtryr_var_normalized <- wl2_wtryr_var %>%
select(cwd:ppt_coldest_month) %>%
scale() #center and scale the data
cor.norm_wtr_yr_var = cor(wl2_wtryr_var_normalized) #test correlations among the traits
cor.sig_wtr_yr_var <- cor.mtest(wl2_wtryr_var_normalized, method = "pearson") #get pearson's test p-values
cor.norm_wtr_yr_var## cwd pck ppt tmn
## cwd 1.00000000 -0.706327469 -6.883437e-01 0.73251141
## pck -0.70632747 1.000000000 8.704319e-01 -0.40438843
## ppt -0.68834373 0.870431902 1.000000e+00 -0.28963515
## tmn 0.73251141 -0.404388428 -2.896352e-01 1.00000000
## tmx 0.85251859 -0.734923879 -7.035544e-01 0.75351699
## ann_tmean 0.84193071 -0.596630788 -5.157099e-01 0.94469376
## mean_diurnal_range 0.02264391 -0.358993431 -4.894150e-01 -0.50703158
## temp_seasonality 0.22169251 0.158401745 7.218531e-05 0.09443653
## temp_ann_range 0.13754077 -0.074078475 -2.262801e-01 -0.20779229
## ann_ppt -0.68834373 0.870431902 1.000000e+00 -0.28963515
## ppt_seasonality 0.19403510 0.129979137 9.366670e-03 0.33264885
## tmean_wettest_month 0.31020889 -0.215672022 -2.351844e-02 0.27958068
## tmean_driest_month -0.02876951 0.150749573 2.368924e-01 0.13034888
## ppt_warmest_month -0.14386285 -0.002770736 3.042050e-03 -0.17448622
## ppt_coldest_month -0.38920806 0.585320238 5.635365e-01 -0.03745338
## tmx ann_tmean mean_diurnal_range
## cwd 0.852518591 0.84193071 0.02264391
## pck -0.734923879 -0.59663079 -0.35899343
## ppt -0.703554351 -0.51570986 -0.48941503
## tmn 0.753516995 0.94469376 -0.50703158
## tmx 1.000000000 0.92744896 0.18459872
## ann_tmean 0.927448958 1.00000000 -0.19631717
## mean_diurnal_range 0.184598716 -0.19631717 1.00000000
## temp_seasonality 0.005302744 0.05636138 -0.13422443
## temp_ann_range 0.041359479 -0.09756177 0.36486107
## ann_ppt -0.703554351 -0.51570986 -0.48941503
## ppt_seasonality 0.173718625 0.27587132 -0.26953366
## tmean_wettest_month 0.204520410 0.26105104 -0.14981712
## tmean_driest_month -0.055787614 0.04631405 -0.26800419
## ppt_warmest_month -0.139777643 -0.16897610 0.07758914
## ppt_coldest_month -0.324111158 -0.18298444 -0.36893842
## temp_seasonality temp_ann_range ann_ppt
## cwd 2.216925e-01 0.13754077 -6.883437e-01
## pck 1.584017e-01 -0.07407847 8.704319e-01
## ppt 7.218531e-05 -0.22628008 1.000000e+00
## tmn 9.443653e-02 -0.20779229 -2.896352e-01
## tmx 5.302744e-03 0.04135948 -7.035544e-01
## ann_tmean 5.636138e-02 -0.09756177 -5.157099e-01
## mean_diurnal_range -1.342244e-01 0.36486107 -4.894150e-01
## temp_seasonality 1.000000e+00 0.64375877 7.218531e-05
## temp_ann_range 6.437588e-01 1.00000000 -2.262801e-01
## ann_ppt 7.218531e-05 -0.22628008 1.000000e+00
## ppt_seasonality 1.964532e-01 -0.03577943 9.366670e-03
## tmean_wettest_month -1.132325e-01 -0.19491722 -2.351844e-02
## tmean_driest_month 9.012687e-02 -0.08375316 2.368924e-01
## ppt_warmest_month -2.029536e-01 -0.20140285 3.042050e-03
## ppt_coldest_month 4.718246e-02 -0.13343442 5.635365e-01
## ppt_seasonality tmean_wettest_month tmean_driest_month
## cwd 0.19403510 0.310208894 -0.028769508
## pck 0.12997914 -0.215672022 0.150749573
## ppt 0.00936667 -0.023518443 0.236892412
## tmn 0.33264885 0.279580677 0.130348878
## tmx 0.17371863 0.204520410 -0.055787614
## ann_tmean 0.27587132 0.261051042 0.046314049
## mean_diurnal_range -0.26953366 -0.149817123 -0.268004194
## temp_seasonality 0.19645324 -0.113232508 0.090126866
## temp_ann_range -0.03577943 -0.194917218 -0.083753164
## ann_ppt 0.00936667 -0.023518443 0.236892412
## ppt_seasonality 1.00000000 -0.142813794 0.064433559
## tmean_wettest_month -0.14281379 1.000000000 -0.005202109
## tmean_driest_month 0.06443356 -0.005202109 1.000000000
## ppt_warmest_month -0.11901333 -0.055166562 -0.373682263
## ppt_coldest_month 0.46926251 -0.344307774 0.330952983
## ppt_warmest_month ppt_coldest_month
## cwd -0.143862853 -0.38920806
## pck -0.002770736 0.58532024
## ppt 0.003042050 0.56353650
## tmn -0.174486220 -0.03745338
## tmx -0.139777643 -0.32411116
## ann_tmean -0.168976099 -0.18298444
## mean_diurnal_range 0.077589137 -0.36893842
## temp_seasonality -0.202953562 0.04718246
## temp_ann_range -0.201402850 -0.13343442
## ann_ppt 0.003042050 0.56353650
## ppt_seasonality -0.119013335 0.46926251
## tmean_wettest_month -0.055166562 -0.34430777
## tmean_driest_month -0.373682263 0.33095298
## ppt_warmest_month 1.000000000 -0.14455760
## ppt_coldest_month -0.144557597 1.00000000cor.sig_wtr_yr_var$p## cwd pck ppt tmn
## cwd 0.000000e+00 2.885331e-10 1.218447e-09 2.890355e-11
## pck 2.885331e-10 0.000000e+00 1.679162e-19 1.352708e-03
## ppt 1.218447e-09 1.679162e-19 0.000000e+00 2.478994e-02
## tmn 2.890355e-11 1.352708e-03 2.478994e-02 0.000000e+00
## tmx 5.539429e-18 2.306887e-11 3.628135e-10 3.724963e-12
## ann_tmean 3.545315e-17 4.883164e-07 2.475966e-05 9.106050e-30
## mean_diurnal_range 8.636488e-01 4.850261e-03 7.236193e-05 3.562142e-05
## temp_seasonality 8.868907e-02 2.267346e-01 9.995633e-01 4.729295e-01
## temp_ann_range 2.946546e-01 5.737669e-01 8.212016e-02 1.111295e-01
## ann_ppt 1.218447e-09 1.679162e-19 0.000000e+00 2.478994e-02
## ppt_seasonality 1.374031e-01 3.222514e-01 9.433745e-01 9.407024e-03
## tmean_wettest_month 1.585856e-02 9.792730e-02 8.584359e-01 3.050963e-02
## tmean_driest_month 8.272694e-01 2.502583e-01 6.839492e-02 3.208650e-01
## ppt_warmest_month 2.728024e-01 9.832372e-01 9.815960e-01 1.824046e-01
## ppt_coldest_month 2.115269e-03 9.017240e-07 2.758413e-06 7.763265e-01
## tmx ann_tmean mean_diurnal_range
## cwd 5.539429e-18 3.545315e-17 8.636488e-01
## pck 2.306887e-11 4.883164e-07 4.850261e-03
## ppt 3.628135e-10 2.475966e-05 7.236193e-05
## tmn 3.724963e-12 9.106050e-30 3.562142e-05
## tmx 0.000000e+00 1.875274e-26 1.579547e-01
## ann_tmean 1.875274e-26 0.000000e+00 1.327490e-01
## mean_diurnal_range 1.579547e-01 1.327490e-01 0.000000e+00
## temp_seasonality 9.679248e-01 6.688478e-01 3.065619e-01
## temp_ann_range 7.537002e-01 4.583389e-01 4.153303e-03
## ann_ppt 3.628135e-10 2.475966e-05 7.236193e-05
## ppt_seasonality 1.843663e-01 3.288126e-02 3.728833e-02
## tmean_wettest_month 1.169973e-01 4.394269e-02 2.532342e-01
## tmean_driest_month 6.720263e-01 7.252964e-01 3.842222e-02
## ppt_warmest_month 2.867959e-01 1.968239e-01 5.556939e-01
## ppt_coldest_month 1.152571e-02 1.616864e-01 3.722616e-03
## temp_seasonality temp_ann_range ann_ppt
## cwd 8.868907e-02 2.946546e-01 1.218447e-09
## pck 2.267346e-01 5.737669e-01 1.679162e-19
## ppt 9.995633e-01 8.212016e-02 0.000000e+00
## tmn 4.729295e-01 1.111295e-01 2.478994e-02
## tmx 9.679248e-01 7.537002e-01 3.628135e-10
## ann_tmean 6.688478e-01 4.583389e-01 2.475966e-05
## mean_diurnal_range 3.065619e-01 4.153303e-03 7.236193e-05
## temp_seasonality 0.000000e+00 2.882793e-08 9.995633e-01
## temp_ann_range 2.882793e-08 0.000000e+00 8.212016e-02
## ann_ppt 9.995633e-01 8.212016e-02 0.000000e+00
## ppt_seasonality 1.324753e-01 7.860810e-01 9.433745e-01
## tmean_wettest_month 3.890069e-01 1.355898e-01 8.584359e-01
## tmean_driest_month 4.934514e-01 5.246321e-01 6.839492e-02
## ppt_warmest_month 1.198899e-01 1.228060e-01 9.815960e-01
## ppt_coldest_month 7.203544e-01 3.094436e-01 2.758413e-06
## ppt_seasonality tmean_wettest_month tmean_driest_month
## cwd 0.1374031081 0.01585856 0.827269432
## pck 0.3222514256 0.09792730 0.250258317
## ppt 0.9433745208 0.85843594 0.068394915
## tmn 0.0094070237 0.03050963 0.320865032
## tmx 0.1843662586 0.11699733 0.672026273
## ann_tmean 0.0328812606 0.04394269 0.725296438
## mean_diurnal_range 0.0372883301 0.25323422 0.038422217
## temp_seasonality 0.1324753316 0.38900685 0.493451368
## temp_ann_range 0.7860809853 0.13558979 0.524632105
## ann_ppt 0.9433745208 0.85843594 0.068394915
## ppt_seasonality 0.0000000000 0.27635166 0.624763897
## tmean_wettest_month 0.2763516644 0.00000000 0.968533247
## tmean_driest_month 0.6247638970 0.96853325 0.000000000
## ppt_warmest_month 0.3650917462 0.67547316 0.003271663
## ppt_coldest_month 0.0001554574 0.00706429 0.009798638
## ppt_warmest_month ppt_coldest_month
## cwd 0.272802412 2.115269e-03
## pck 0.983237212 9.017240e-07
## ppt 0.981596049 2.758413e-06
## tmn 0.182404636 7.763265e-01
## tmx 0.286795919 1.152571e-02
## ann_tmean 0.196823933 1.616864e-01
## mean_diurnal_range 0.555693874 3.722616e-03
## temp_seasonality 0.119889877 7.203544e-01
## temp_ann_range 0.122806025 3.094436e-01
## ann_ppt 0.981596049 2.758413e-06
## ppt_seasonality 0.365091746 1.554574e-04
## tmean_wettest_month 0.675473155 7.064290e-03
## tmean_driest_month 0.003271663 9.798638e-03
## ppt_warmest_month 0.000000000 2.704687e-01
## ppt_coldest_month 0.270468691 0.000000e+00#ann_ppt and ppt 100% correlated (ppt = avg across monts, ann_ppt = avg of the total ppt in a year) - only keep ann_ppt
#ann_tmean highly corr with tmn, tmx - take it out
wl2_wtryr_var.pc = prcomp(wl2_wtryr_var[c(8:9, 11:12, 14:22)], scale = TRUE, center = TRUE)
summary(wl2_wtryr_var.pc)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.0414 1.5870 1.3858 1.11291 1.03643 0.80685 0.70966
## Proportion of Variance 0.3206 0.1937 0.1477 0.09527 0.08263 0.05008 0.03874
## Cumulative Proportion 0.3206 0.5143 0.6620 0.75728 0.83991 0.88998 0.92872
## PC8 PC9 PC10 PC11 PC12 PC13
## Standard deviation 0.57599 0.4864 0.42556 0.31916 0.27436 2.322e-15
## Proportion of Variance 0.02552 0.0182 0.01393 0.00784 0.00579 0.000e+00
## Cumulative Proportion 0.95424 0.9724 0.98637 0.99421 1.00000 1.000e+00tibble(PC=str_c("PC",str_pad(1:13,2,pad="0")),
percent_var=wl2_wtryr_var.pc$sdev[1:13]^2/sum(wl2_wtryr_var.pc$sdev^2)*100) %>%
ggplot(aes(x=PC, y=percent_var)) +
geom_col() +
ggtitle("Percent Variance Explained")
#combine pcs with metadata
wl2_wtryr_var.pc.dat = data.frame(wl2_wtryr_var.pc$x)
wl2_wtryr_var_locs.pc = cbind(wl2_wtryr_var, wl2_wtryr_var.pc.dat) %>% select(parent.pop:year, PC1:PC13)
wl2_wtryr_var_loadings = data.frame(varnames=rownames(wl2_wtryr_var.pc$rotation), wl2_wtryr_var.pc$rotation)
wl2_wtryr_var_loadings## varnames PC1 PC2 PC3
## cwd cwd 0.436983367 0.20245646 0.05914300
## pck pck -0.442699899 0.10155366 0.07303354
## tmn tmn 0.288600920 0.45859941 -0.13529934
## tmx tmx 0.438031973 0.16160038 -0.01005479
## mean_diurnal_range mean_diurnal_range 0.142845627 -0.47370951 0.18908155
## temp_seasonality temp_seasonality 0.016311978 0.15487758 0.56775231
## temp_ann_range temp_ann_range 0.074890388 -0.14682469 0.62908917
## ann_ppt ann_ppt -0.430324868 0.14711055 -0.09536193
## ppt_seasonality ppt_seasonality -0.003010692 0.38643033 0.15005153
## tmean_wettest_month tmean_wettest_month 0.152030759 0.08381173 -0.31507960
## tmean_driest_month tmean_driest_month -0.094759098 0.31183613 0.06767535
## ppt_warmest_month ppt_warmest_month -0.034841714 -0.25272138 -0.27255555
## ppt_coldest_month ppt_coldest_month -0.305164173 0.32127976 0.09572096
## PC4 PC5 PC6 PC7
## cwd 0.0005698593 -0.09868912 -0.049149321 -0.08162993
## pck 0.0191743564 -0.17206314 0.110985163 0.01478149
## tmn -0.0472323390 -0.12245316 -0.158743137 0.22248967
## tmx -0.1216647961 0.11849681 0.004727255 0.01109850
## mean_diurnal_range -0.0889003661 0.33841605 0.243508674 -0.31805723
## temp_seasonality 0.1344517052 -0.43284986 -0.185030500 -0.06818229
## temp_ann_range 0.1218037763 -0.15798484 0.024608336 -0.07066957
## ann_ppt 0.1624867380 -0.15794168 0.055176339 0.01477315
## ppt_seasonality -0.5148110180 -0.01753416 0.422852603 -0.35287736
## tmean_wettest_month 0.5116719546 -0.31358765 0.477293067 -0.45032544
## tmean_driest_month 0.3721497039 0.49347545 -0.462926043 -0.49981111
## ppt_warmest_month -0.4081150706 -0.43399911 -0.483547673 -0.49272535
## ppt_coldest_month -0.2889433863 0.22206156 0.090168063 -0.11210139
## PC8 PC9 PC10 PC11 PC12
## cwd 0.05086382 -0.10530223 -0.13174931 -0.83433245 -0.13636662
## pck 0.13209122 -0.51166806 0.14736785 -0.24189888 0.62159113
## tmn 0.21071408 -0.03435290 0.19555705 0.22403851 0.10489693
## tmx 0.43275937 -0.33184786 0.14971623 0.29136671 0.03496071
## mean_diurnal_range 0.25236885 -0.38371671 -0.09605862 0.04707553 -0.11097874
## temp_seasonality -0.10209115 -0.25165977 -0.49018475 0.27945672 -0.13019373
## temp_ann_range 0.24991099 0.42215057 0.52660396 -0.06472166 0.09756226
## ann_ppt 0.30549620 -0.21461309 0.28154629 -0.06476127 -0.71177656
## ppt_seasonality -0.42758973 -0.04022233 0.24009674 0.07318879 -0.10967507
## tmean_wettest_month 0.11497724 0.15799708 -0.10835357 0.11392014 0.13014943
## tmean_driest_month -0.13608741 -0.05400561 0.13644929 0.01734213 0.05213777
## ppt_warmest_month 0.14305222 0.04590312 0.07136211 0.01475864 0.03521739
## ppt_coldest_month 0.53230738 0.38646922 -0.44842060 -0.05233012 0.06682770
## PC13
## cwd -1.801745e-16
## pck -7.060016e-16
## tmn 6.716723e-01
## tmx -5.890564e-01
## mean_diurnal_range 4.492981e-01
## temp_seasonality 3.817788e-16
## temp_ann_range -4.782631e-17
## ann_ppt 3.790174e-16
## ppt_seasonality -2.887139e-16
## tmean_wettest_month 1.684982e-16
## tmean_driest_month 1.225983e-16
## ppt_warmest_month -5.150502e-17
## ppt_coldest_month 5.087270e-16Plot the PCA
autoplot(wl2_wtryr_var.pc, data = wl2_wtryr_var,
colour='year', alpha=0.6,
loadings=TRUE, loadings.colour='black', loadings.linewidth = 0.7,
loadings.label = TRUE, loadings.label.size=6, loadings.label.colour="black",
loadings.label.vjust = -0.2, loadings.label.repel=TRUE) +
scale_color_viridis() +
geom_vline(xintercept = 0, linetype="dashed") + geom_hline(yintercept = 0, linetype="dashed") +
theme_classic()
wl2_yrl_var_pca_wtryr <- wl2_wtryr_var_locs.pc %>%
mutate(group=str_c(year)) %>%
ggplot(aes(x=PC1, y=PC2, color=year)) +
geom_point(size=4, alpha=0.7) +
scale_color_viridis() +
labs(x="PC1 (32.06%)", y="PC2 (19.37%)", color="Year") +
geom_vline(xintercept = 0, linetype="dashed") + geom_hline(yintercept = 0, linetype="dashed") +
#PC1: cwd and tmx = pos; pck and ann_ppt = neg:
annotate("text", x = -5, y = -6.4, label = "Wet \n Snow", size=6) +
annotate("text", x = 4, y = -6.4, label = "Dry \n No Snow", size=6) +
#PC2: tmn = pos; mean diurnal range = neg:
annotate("text", x = -7.8, y = -3.7, label = "Low Min \n Temp", size=6) +
annotate("text", x = -7.8, y = 4, label = "High Min \n Temp", size=6) +
coord_cartesian(ylim = c(-5, 5), xlim = c(-6,5), clip = "off") +
theme_classic() +
theme(text=element_text(size=28))
## add WL2 garden 2023 and 2024
WL2GRDN_wtryr_pc_prep_2023_var <- all_clim %>%
ungroup() %>%
filter(parent.pop=="WL2_Garden", year==2023, Season=="Water Year") %>%
select(cwd:pck, tmn:tmx, mean_diurnal_range, temp_seasonality, temp_ann_range, ann_ppt, ppt_seasonality, tmean_wettest_month, tmean_driest_month, ppt_warmest_month, ppt_coldest_month)
WL2GRDN_wtryr_predicted_2023_var <- predict(wl2_wtryr_var.pc, newdata = WL2GRDN_wtryr_pc_prep_2023_var)
WL2GRDN_wtryr_pc_prep_2024_var <- all_clim %>%
ungroup() %>%
filter(parent.pop=="WL2_Garden", year==2024, Season=="Water Year") %>%
select(cwd:pck, tmn:tmx, mean_diurnal_range, temp_seasonality, temp_ann_range, ann_ppt, ppt_seasonality, tmean_wettest_month, tmean_driest_month, ppt_warmest_month, ppt_coldest_month)
WL2GRDN_wtryr_2024_var_predicted <- predict(wl2_wtryr_var.pc, newdata = WL2GRDN_wtryr_pc_prep_2024_var)
wl2_yrl_var_pca_wtryr$data <- rbind(wl2_yrl_var_pca_wtryr$data,
data.frame(
parent.pop = "WL2_Garden",
elevation.group="High",
elev_m = 2020,
Lat = 38.8263,
Long=-120.2524,
timeframe = c("2023", "2024"),
year = c(2023, 2024),
PC1 = c(WL2GRDN_wtryr_predicted_2023_var[, "PC1"], WL2GRDN_wtryr_2024_var_predicted[, "PC1"]),
PC2 = c(WL2GRDN_wtryr_predicted_2023_var[, "PC2"], WL2GRDN_wtryr_2024_var_predicted[, "PC2"]),
PC3 = c(WL2GRDN_wtryr_predicted_2023_var[, "PC3"], WL2GRDN_wtryr_2024_var_predicted[, "PC3"]),
PC4 = c(WL2GRDN_wtryr_predicted_2023_var[, "PC4"], WL2GRDN_wtryr_2024_var_predicted[, "PC4"]),
PC5 = c(WL2GRDN_wtryr_predicted_2023_var[, "PC5"], WL2GRDN_wtryr_2024_var_predicted[, "PC5"]),
PC6 = c(WL2GRDN_wtryr_predicted_2023_var[, "PC6"], WL2GRDN_wtryr_2024_var_predicted[, "PC6"]),
PC7 = c(WL2GRDN_wtryr_predicted_2023_var[, "PC7"], WL2GRDN_wtryr_2024_var_predicted[, "PC7"]),
PC8 = c(WL2GRDN_wtryr_predicted_2023_var[, "PC8"], WL2GRDN_wtryr_2024_var_predicted[, "PC8"]),
PC9 = c(WL2GRDN_wtryr_predicted_2023_var[, "PC9"], WL2GRDN_wtryr_2024_var_predicted[, "PC9"]),
PC10 = c(WL2GRDN_wtryr_predicted_2023_var[, "PC10"], WL2GRDN_wtryr_2024_var_predicted[, "PC10"]),
PC11 = c(WL2GRDN_wtryr_predicted_2023_var[, "PC11"], WL2GRDN_wtryr_2024_var_predicted[, "PC11"]),
PC12 = c(WL2GRDN_wtryr_predicted_2023_var[, "PC12"], WL2GRDN_wtryr_2024_var_predicted[, "PC12"]),
PC13 = c(WL2GRDN_wtryr_predicted_2023_var[, "PC13"], WL2GRDN_wtryr_2024_var_predicted[, "PC13"]),
group = c("new", "new2")
)
)
wl2_yrl_var_pca_wtryr +
geom_point(data=filter(wl2_yrl_var_pca_wtryr$data, parent.pop == "WL2_Garden"), size=8, shape = 18, show.legend = FALSE) +
annotate("text", x = -5.5, y= 1.2, label = "WL2 \n Garden \n 2023", colour = "purple", size=7) +
annotate("text", x = 0.9, y= 3, label = "WL2 Garden 2024", colour = "purple", size=7) 
ggsave("../Figures/Wtr_Year_WL2ONLY_PC1-PC2.png", width = 7.4, height = 6, units = "in")Growth Season
wl2_grwssn_var <- all_clim %>%
filter(parent.pop=="WL2", Season=="Growth Season") %>%
ungroup()
wl2_grwssn_var_normalized <- wl2_grwssn_var %>%
select(cwd:ppt_coldest_month) %>%
scale() #center and scale the data
cor.norm_grwssn_var = cor(wl2_grwssn_var_normalized) #test correlations among the traits
cor.sig_grwssn_var <- cor.mtest(wl2_grwssn_var_normalized, method = "pearson") #get pearson's test p-values
cor.norm_grwssn_var## cwd pck ppt tmn
## cwd 1.000000000 0.07108600 0.001915216 0.79236684
## pck 0.071085998 1.00000000 0.721708604 0.00673063
## ppt 0.001915216 0.72170860 1.000000000 0.01524654
## tmn 0.792366844 0.00673063 0.015246540 1.00000000
## tmx 0.875849564 -0.04825579 -0.121627851 0.74920992
## ann_tmean 0.891981908 -0.02225487 -0.057009796 0.93495785
## mean_diurnal_range 0.122180554 -0.07774622 -0.193536791 -0.34959280
## temp_seasonality 0.032901868 0.29582015 -0.048850171 0.15848266
## temp_ann_range 0.191352846 0.16612463 -0.290531412 0.06602322
## ann_ppt -0.073070789 0.64979578 0.835647084 -0.03275025
## ppt_seasonality 0.433765839 0.46979081 0.265838642 0.34873776
## tmean_wettest_month -0.032567737 -0.49166563 -0.089105470 0.01633325
## tmean_driest_month 0.142440419 0.17918168 0.166686105 0.31931077
## ppt_warmest_month -0.156830607 0.07632095 0.149144244 -0.05579174
## ppt_coldest_month 0.232549236 0.83036687 0.828691127 0.16885690
## tmx ann_tmean mean_diurnal_range
## cwd 0.87584956 0.891981908 0.122180554
## pck -0.04825579 -0.022254875 -0.077746222
## ppt -0.12162785 -0.057009796 -0.193536791
## tmn 0.74920992 0.934957847 -0.349592800
## tmx 1.00000000 0.935448038 0.358622183
## ann_tmean 0.93544804 1.000000000 0.005519632
## mean_diurnal_range 0.35862218 0.005519632 1.000000000
## temp_seasonality -0.01307287 0.077574674 -0.241855580
## temp_ann_range 0.13596388 0.108059352 0.099275288
## ann_ppt -0.26674903 -0.160353895 -0.331171735
## ppt_seasonality 0.47350006 0.439725671 0.178282515
## tmean_wettest_month -0.01029730 0.003201056 -0.037585894
## tmean_driest_month 0.16713505 0.259926162 -0.213611695
## ppt_warmest_month -0.22683918 -0.151273824 -0.242242939
## ppt_coldest_month 0.15560595 0.173458861 -0.017872475
## temp_seasonality temp_ann_range ann_ppt ppt_seasonality
## cwd 0.03290187 0.191352846 -0.07307079 0.433765839
## pck 0.29582015 0.166124631 0.64979578 0.469790812
## ppt -0.04885017 -0.290531412 0.83564708 0.265838642
## tmn 0.15848266 0.066023216 -0.03275025 0.348737764
## tmx -0.01307287 0.135963882 -0.26674903 0.473500056
## ann_tmean 0.07757467 0.108059352 -0.16035389 0.439725671
## mean_diurnal_range -0.24185558 0.099275288 -0.33117173 0.178282515
## temp_seasonality 1.00000000 0.675079272 0.05231027 0.052749436
## temp_ann_range 0.67507927 1.000000000 -0.01620131 -0.001332629
## ann_ppt 0.05231027 -0.016201313 1.00000000 0.161195707
## ppt_seasonality 0.05274944 -0.001332629 0.16119571 1.000000000
## tmean_wettest_month -0.19373204 -0.294347252 -0.10723315 -0.206824039
## tmean_driest_month 0.41650884 0.154921582 0.19077217 0.237659643
## ppt_warmest_month -0.24057049 -0.309529796 0.06344700 -0.332376918
## ppt_coldest_month -0.02718380 -0.163858464 0.66991108 0.603064543
## tmean_wettest_month tmean_driest_month ppt_warmest_month
## cwd -0.032567737 0.1424404 -0.15683061
## pck -0.491665632 0.1791817 0.07632095
## ppt -0.089105470 0.1666861 0.14914424
## tmn 0.016333251 0.3193108 -0.05579174
## tmx -0.010297296 0.1671351 -0.22683918
## ann_tmean 0.003201056 0.2599262 -0.15127382
## mean_diurnal_range -0.037585894 -0.2136117 -0.24224294
## temp_seasonality -0.193732039 0.4165088 -0.24057049
## temp_ann_range -0.294347252 0.1549216 -0.30952980
## ann_ppt -0.107233145 0.1907722 0.06344700
## ppt_seasonality -0.206824039 0.2376596 -0.33237692
## tmean_wettest_month 1.000000000 -0.1466569 -0.04669263
## tmean_driest_month -0.146656859 1.0000000 -0.46679234
## ppt_warmest_month -0.046692625 -0.4667923 1.00000000
## ppt_coldest_month -0.323686290 0.2128168 0.04222958
## ppt_coldest_month
## cwd 0.23254924
## pck 0.83036687
## ppt 0.82869113
## tmn 0.16885690
## tmx 0.15560595
## ann_tmean 0.17345886
## mean_diurnal_range -0.01787248
## temp_seasonality -0.02718380
## temp_ann_range -0.16385846
## ann_ppt 0.66991108
## ppt_seasonality 0.60306454
## tmean_wettest_month -0.32368629
## tmean_driest_month 0.21281684
## ppt_warmest_month 0.04222958
## ppt_coldest_month 1.00000000cor.sig_grwssn_var$p## cwd pck ppt tmn
## cwd 0.000000e+00 5.893830e-01 9.884126e-01 4.636813e-14
## pck 5.893830e-01 0.000000e+00 7.707029e-11 9.592944e-01
## ppt 9.884126e-01 7.707029e-11 0.000000e+00 9.079525e-01
## tmn 4.636813e-14 9.592944e-01 9.079525e-01 0.000000e+00
## tmx 5.260109e-20 7.142620e-01 3.545760e-01 5.763379e-12
## ann_tmean 1.169900e-21 8.659696e-01 6.652627e-01 8.762987e-28
## mean_diurnal_range 3.523771e-01 5.548916e-01 1.384355e-01 6.182483e-03
## temp_seasonality 8.029252e-01 2.174262e-02 7.108957e-01 2.264943e-01
## temp_ann_range 1.430288e-01 2.045971e-01 2.432722e-02 6.162283e-01
## ann_ppt 5.790041e-01 1.936250e-08 1.001585e-16 8.038153e-01
## ppt_seasonality 5.355162e-04 1.524636e-04 4.007636e-02 6.318244e-03
## tmean_wettest_month 8.048870e-01 6.623998e-05 4.983822e-01 9.014233e-01
## tmean_driest_month 2.776223e-01 1.707325e-01 2.030495e-01 1.288913e-02
## ppt_warmest_month 2.314344e-01 5.621912e-01 2.553966e-01 6.720034e-01
## ppt_coldest_month 7.377161e-02 2.318982e-16 3.008875e-16 1.971446e-01
## tmx ann_tmean mean_diurnal_range
## cwd 5.260109e-20 1.169900e-21 0.352377063
## pck 7.142620e-01 8.659696e-01 0.554891565
## ppt 3.545760e-01 6.652627e-01 0.138435475
## tmn 5.763379e-12 8.762987e-28 0.006182483
## tmx 0.000000e+00 7.085082e-28 0.004897635
## ann_tmean 7.085082e-28 0.000000e+00 0.966613661
## mean_diurnal_range 4.897635e-03 9.666137e-01 0.000000000
## temp_seasonality 9.210302e-01 5.557678e-01 0.062639708
## temp_ann_range 3.002783e-01 4.111754e-01 0.450444678
## ann_ppt 3.937394e-02 2.209878e-01 0.009747342
## ppt_seasonality 1.328874e-04 4.391553e-04 0.172924373
## tmean_wettest_month 9.377591e-01 9.806343e-01 0.775555714
## tmean_driest_month 2.018182e-01 4.489426e-02 0.101255224
## ppt_warmest_month 8.134658e-02 2.485957e-01 0.062207463
## ppt_coldest_month 2.351443e-01 1.850335e-01 0.892186399
## temp_seasonality temp_ann_range ann_ppt
## cwd 8.029252e-01 1.430288e-01 5.790041e-01
## pck 2.174262e-02 2.045971e-01 1.936250e-08
## ppt 7.108957e-01 2.432722e-02 1.001585e-16
## tmn 2.264943e-01 6.162283e-01 8.038153e-01
## tmx 9.210302e-01 3.002783e-01 3.937394e-02
## ann_tmean 5.557678e-01 4.111754e-01 2.209878e-01
## mean_diurnal_range 6.263971e-02 4.504447e-01 9.747342e-03
## temp_seasonality 0.000000e+00 3.306021e-09 6.914103e-01
## temp_ann_range 3.306021e-09 0.000000e+00 9.022156e-01
## ann_ppt 6.914103e-01 9.022156e-01 0.000000e+00
## ppt_seasonality 6.889510e-01 9.919372e-01 2.185414e-01
## tmean_wettest_month 1.380303e-01 2.243790e-02 4.147824e-01
## tmean_driest_month 9.322849e-04 2.372352e-01 1.442690e-01
## ppt_warmest_month 6.409107e-02 1.610188e-02 6.300860e-01
## ppt_coldest_month 8.366555e-01 2.109279e-01 4.811186e-09
## ppt_seasonality tmean_wettest_month tmean_driest_month
## cwd 5.355162e-04 8.048870e-01 0.2776222600
## pck 1.524636e-04 6.623998e-05 0.1707324668
## ppt 4.007636e-02 4.983822e-01 0.2030495458
## tmn 6.318244e-03 9.014233e-01 0.0128891339
## tmx 1.328874e-04 9.377591e-01 0.2018181597
## ann_tmean 4.391553e-04 9.806343e-01 0.0448942579
## mean_diurnal_range 1.729244e-01 7.755557e-01 0.1012552236
## temp_seasonality 6.889510e-01 1.380303e-01 0.0009322849
## temp_ann_range 9.919372e-01 2.243790e-02 0.2372352020
## ann_ppt 2.185414e-01 4.147824e-01 0.1442689879
## ppt_seasonality 0.000000e+00 1.128419e-01 0.0674785641
## tmean_wettest_month 1.128419e-01 0.000000e+00 0.2634982156
## tmean_driest_month 6.747856e-02 2.634982e-01 0.0000000000
## ppt_warmest_month 9.468890e-03 7.231406e-01 0.0001701831
## ppt_coldest_month 3.408547e-07 1.164114e-02 0.1025623095
## ppt_warmest_month ppt_coldest_month
## cwd 0.2314344471 7.377161e-02
## pck 0.5621912098 2.318982e-16
## ppt 0.2553965582 3.008875e-16
## tmn 0.6720034007 1.971446e-01
## tmx 0.0813465764 2.351443e-01
## ann_tmean 0.2485956632 1.850335e-01
## mean_diurnal_range 0.0622074629 8.921864e-01
## temp_seasonality 0.0640910665 8.366555e-01
## temp_ann_range 0.0161018750 2.109279e-01
## ann_ppt 0.6300860398 4.811186e-09
## ppt_seasonality 0.0094688895 3.408547e-07
## tmean_wettest_month 0.7231406341 1.164114e-02
## tmean_driest_month 0.0001701831 1.025623e-01
## ppt_warmest_month 0.0000000000 7.486872e-01
## ppt_coldest_month 0.7486872309 0.000000e+00#ann_tmean highly corr with tmn, tmx - take it out
wl2_grwssn_var.pc = prcomp(wl2_grwssn_var[c(8:12, 14:22)], scale = TRUE, center = TRUE)
summary(wl2_grwssn_var.pc)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 1.9682 1.7600 1.4430 1.2494 1.09753 0.87053 0.71059
## Proportion of Variance 0.2767 0.2213 0.1487 0.1115 0.08604 0.05413 0.03607
## Cumulative Proportion 0.2767 0.4980 0.6467 0.7582 0.84423 0.89836 0.93443
## PC8 PC9 PC10 PC11 PC12 PC13 PC14
## Standard deviation 0.64409 0.44283 0.33614 0.2994 0.24307 0.21307 1.13e-15
## Proportion of Variance 0.02963 0.01401 0.00807 0.0064 0.00422 0.00324 0.00e+00
## Cumulative Proportion 0.96406 0.97807 0.98614 0.9925 0.99676 1.00000 1.00e+00tibble(PC=str_c("PC",str_pad(1:14,2,pad="0")),
percent_var=wl2_grwssn_var.pc$sdev[1:14]^2/sum(wl2_grwssn_var.pc$sdev^2)*100) %>%
ggplot(aes(x=PC, y=percent_var)) +
geom_col() +
ggtitle("Percent Variance Explained")
#combine pcs with metadata
wl2_grwssn_var.pc.dat = data.frame(wl2_grwssn_var.pc$x)
wl2_grwssn_var_locs.pc = cbind(wl2_grwssn_var, wl2_grwssn_var.pc.dat) %>% select(parent.pop:year, PC1:PC14)
wl2_grwssn_var_loadings = data.frame(varnames=rownames(wl2_grwssn_var.pc$rotation), wl2_grwssn_var.pc$rotation)
wl2_grwssn_var_loadings## varnames PC1 PC2 PC3
## cwd cwd -0.21631334 0.42556298 0.21510451
## pck pck -0.42681741 -0.18924520 -0.10813666
## ppt ppt -0.37671792 -0.30361310 0.14685310
## tmn tmn -0.21075853 0.37060449 0.14355308
## tmx tmx -0.15925575 0.48124787 0.24391924
## mean_diurnal_range mean_diurnal_range 0.07176527 0.15842351 0.14271383
## temp_seasonality temp_seasonality -0.12899049 0.11551843 -0.56653923
## temp_ann_range temp_ann_range -0.05274955 0.21186364 -0.51404283
## ann_ppt ann_ppt -0.33999384 -0.31354318 -0.03053116
## ppt_seasonality ppt_seasonality -0.34227573 0.18228507 0.13267491
## tmean_wettest_month tmean_wettest_month 0.19872279 0.02424267 0.22338048
## tmean_driest_month tmean_driest_month -0.22433906 0.13898586 -0.28492298
## ppt_warmest_month ppt_warmest_month 0.06660781 -0.25772149 0.24108489
## ppt_coldest_month ppt_coldest_month -0.45580953 -0.14409462 0.16448701
## PC4 PC5 PC6 PC7
## cwd 0.09530532 -0.17609967 -0.19256391 -0.184970830
## pck -0.17008271 -0.18129930 -0.06311777 0.140463293
## ppt 0.05924659 0.11868507 -0.18792222 -0.183028965
## tmn 0.44842068 -0.14100082 0.06076465 0.018906473
## tmx -0.03906588 -0.08533311 -0.07354074 -0.166747223
## mean_diurnal_range -0.68725874 0.07801684 -0.18966785 -0.262518602
## temp_seasonality 0.13137843 -0.09650536 -0.19202250 0.285401305
## temp_ann_range -0.13910707 -0.25637354 -0.39937152 -0.107075070
## ann_ppt 0.12020723 0.11143419 -0.31719682 -0.258568808
## ppt_seasonality -0.23279880 0.15315298 0.16387021 0.674595469
## tmean_wettest_month 0.28360856 0.44835251 -0.62924657 0.251900053
## tmean_driest_month 0.20642352 0.43882995 0.39767533 -0.369452651
## ppt_warmest_month 0.20133270 -0.61981577 0.01487830 0.003157498
## ppt_coldest_month -0.12129024 0.01031220 0.01975454 0.025757065
## PC8 PC9 PC10 PC11
## cwd -0.12386660 -0.09500870 -0.39435451 0.65509296
## pck 0.13542833 -0.11310706 -0.48087994 -0.20793000
## ppt 0.14313920 -0.29426742 0.19208421 0.06824210
## tmn -0.08000572 -0.07718079 0.17497205 -0.34792443
## tmx 0.16090219 -0.03041269 0.29774657 -0.31294634
## mean_diurnal_range 0.34036300 0.06575736 0.17457375 0.04768224
## temp_seasonality 0.44001514 -0.30781909 0.31560367 0.25788954
## temp_ann_range -0.23266939 0.36351540 -0.13593986 -0.26277070
## ann_ppt -0.35162459 0.30590509 0.39260665 0.16301237
## ppt_seasonality -0.10835970 0.39158816 0.17568417 0.19149286
## tmean_wettest_month 0.26084834 0.16734672 -0.23567276 -0.12662979
## tmean_driest_month 0.36776044 0.38424004 -0.17400538 0.05538355
## ppt_warmest_month 0.45021759 0.47495498 0.05497489 0.10428023
## ppt_coldest_month 0.09259849 -0.07306279 -0.18618923 -0.27004835
## PC12 PC13 PC14
## cwd 0.0733625621 0.005617524 2.343596e-16
## pck -0.5383363248 0.298977954 -7.121515e-17
## ppt -0.1905553459 -0.687734960 5.842040e-16
## tmn -0.0961644655 0.032514508 -6.310977e-01
## tmx -0.1248252557 0.106439481 6.334091e-01
## mean_diurnal_range -0.0410384827 0.104738314 -4.477818e-01
## temp_seasonality 0.1492168464 0.165547109 2.193148e-16
## temp_ann_range 0.0929882919 -0.386777713 1.347314e-17
## ann_ppt -0.0435459524 0.437031651 8.609880e-17
## ppt_seasonality -0.0820347247 -0.181895532 9.322366e-17
## tmean_wettest_month -0.0003577508 0.039247525 -5.897955e-17
## tmean_driest_month -0.0434393683 -0.035073449 8.528549e-17
## ppt_warmest_month 0.0261075475 -0.056806715 1.202675e-16
## ppt_coldest_month 0.7745194276 0.084626061 -3.678699e-16Plot the PCA
autoplot(wl2_grwssn_var.pc, data = wl2_grwssn_var,
colour='year', alpha=0.6,
loadings=TRUE, loadings.colour='black', loadings.linewidth = 0.7,
loadings.label = TRUE, loadings.label.size=6, loadings.label.colour="black",
loadings.label.vjust = -0.2, loadings.label.repel=TRUE) +
scale_color_viridis() +
geom_vline(xintercept = 0, linetype="dashed") + geom_hline(yintercept = 0, linetype="dashed") +
theme_classic()
wl2_yrl_var_pca_grwssn <- wl2_grwssn_var_locs.pc %>%
mutate(group=str_c(year)) %>%
ggplot(aes(x=PC1, y=PC2, color=year)) +
geom_point(size=4, alpha=0.7) +
scale_color_viridis() +
labs(x="PC1 (27.67%)", y="PC2 (22.13%)", color="Year") +
geom_vline(xintercept = 0, linetype="dashed") + geom_hline(yintercept = 0, linetype="dashed") +
#PC1: pck and ppt_coldest_month = neg:
annotate("text", x = -4.5, y = -5.8, label = "Snow", size=6) +
annotate("text", x = 3.2, y = -5.8, label = "No Snow", size=6) +
#PC2: cwd and tmx = pos:
annotate("text", x = -6.6, y = -3.7, label = "Wet \n Cold", size=6) +
annotate("text", x = -6.6, y = 3.5, label = "Dry \n Hot", size=6) +
coord_cartesian(ylim = c(-4.5, 4.5), xlim = c(-5.5,3.5), clip = "off") +
theme_classic() +
theme(text=element_text(size=28))
## add WL2 garden 2023 and 2024
WL2GRDN_grwssn_pc_prep_2023_var <- all_clim %>%
ungroup() %>%
filter(parent.pop=="WL2_Garden", year==2023, Season=="Growth Season") %>%
select(cwd:tmx, mean_diurnal_range, temp_seasonality, temp_ann_range, ann_ppt, ppt_seasonality, tmean_wettest_month, tmean_driest_month, ppt_warmest_month, ppt_coldest_month)
WL2GRDN_grwssn_predicted_2023_var <- predict(wl2_grwssn_var.pc, newdata = WL2GRDN_grwssn_pc_prep_2023_var)
WL2GRDN_grwssn_pc_prep_2024_var <- all_clim %>%
ungroup() %>%
filter(parent.pop=="WL2_Garden", year==2024, Season=="Growth Season") %>%
select(cwd:tmx, mean_diurnal_range, temp_seasonality, temp_ann_range, ann_ppt, ppt_seasonality, tmean_wettest_month, tmean_driest_month, ppt_warmest_month, ppt_coldest_month)
WL2GRDN_grwssn_2024_var_predicted <- predict(wl2_grwssn_var.pc, newdata = WL2GRDN_grwssn_pc_prep_2024_var)
wl2_yrl_var_pca_grwssn$data <- rbind(wl2_yrl_var_pca_grwssn$data,
data.frame(
parent.pop = "WL2_Garden",
elevation.group="High",
elev_m = 2020,
Lat = 38.8263,
Long=-120.2524,
timeframe = c("2023", "2024"),
year = c(2023, 2024),
PC1 = c(WL2GRDN_grwssn_predicted_2023_var[, "PC1"], WL2GRDN_grwssn_2024_var_predicted[, "PC1"]),
PC2 = c(WL2GRDN_grwssn_predicted_2023_var[, "PC2"], WL2GRDN_grwssn_2024_var_predicted[, "PC2"]),
PC3 = c(WL2GRDN_grwssn_predicted_2023_var[, "PC3"], WL2GRDN_grwssn_2024_var_predicted[, "PC3"]),
PC4 = c(WL2GRDN_grwssn_predicted_2023_var[, "PC4"], WL2GRDN_grwssn_2024_var_predicted[, "PC4"]),
PC5 = c(WL2GRDN_grwssn_predicted_2023_var[, "PC5"], WL2GRDN_grwssn_2024_var_predicted[, "PC5"]),
PC6 = c(WL2GRDN_grwssn_predicted_2023_var[, "PC6"], WL2GRDN_grwssn_2024_var_predicted[, "PC6"]),
PC7 = c(WL2GRDN_grwssn_predicted_2023_var[, "PC7"], WL2GRDN_grwssn_2024_var_predicted[, "PC7"]),
PC8 = c(WL2GRDN_grwssn_predicted_2023_var[, "PC8"], WL2GRDN_grwssn_2024_var_predicted[, "PC8"]),
PC9 = c(WL2GRDN_grwssn_predicted_2023_var[, "PC9"], WL2GRDN_grwssn_2024_var_predicted[, "PC9"]),
PC10 = c(WL2GRDN_grwssn_predicted_2023_var[, "PC10"], WL2GRDN_grwssn_2024_var_predicted[, "PC10"]),
PC11 = c(WL2GRDN_grwssn_predicted_2023_var[, "PC11"], WL2GRDN_grwssn_2024_var_predicted[, "PC11"]),
PC12 = c(WL2GRDN_grwssn_predicted_2023_var[, "PC12"], WL2GRDN_grwssn_2024_var_predicted[, "PC12"]),
PC13 = c(WL2GRDN_grwssn_predicted_2023_var[, "PC13"], WL2GRDN_grwssn_2024_var_predicted[, "PC13"]),
PC14 = c(WL2GRDN_grwssn_predicted_2023_var[, "PC14"], WL2GRDN_grwssn_2024_var_predicted[, "PC14"]),
group = c("new", "new2")
)
)
wl2_yrl_var_pca_grwssn +
geom_point(data=filter(wl2_yrl_var_pca_grwssn$data, parent.pop == "WL2_Garden"), size=8, shape = 18, show.legend = FALSE) +
annotate("text", x = 3.24, y= -4.5, label = "WL2 Garden 2023", colour = "purple", size=7) +
annotate("text", x = -0.51, y= 4.6, label = "WL2 Garden 2024", colour = "purple", size=7) 
ggsave("../Figures/Growth_Ssn_WL2ONLY_PC1-PC2.png", width = 7.4, height = 6, units = "in")
#WL2GRDN_grwssn_pc_prep_2023_var %>% select(pck)
#WL2GRDN_grwssn_pc_prep_2024_var %>% select(pck)
#wl2_grwssn_var %>% select(pck)